diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cd/cd10002.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cd/cd10002.a | 1198 |
1 files changed, 0 insertions, 1198 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cd/cd10002.a b/gcc/testsuite/ada/acats/tests/cd/cd10002.a deleted file mode 100644 index fc56d4299df..00000000000 --- a/gcc/testsuite/ada/acats/tests/cd/cd10002.a +++ /dev/null @@ -1,1198 +0,0 @@ --- CD10002.A --- --- Grant of Unlimited Rights --- --- The Ada Conformity Assessment Authority (ACAA) holds unlimited --- rights in the software and documentation contained herein. Unlimited --- rights are the same as those granted by the U.S. Government for older --- parts of the Ada Conformity Assessment Test Suite, and are defined --- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA --- intends to confer upon all recipients unlimited rights equal to those --- held by the ACAA. These rights include rights to use, duplicate, --- release or disclose the released technical data and computer software --- in whole or in part, in any manner and for any purpose whatsoever, and --- to have or permit others to do so. --- --- DISCLAIMER --- --- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR --- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED --- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE --- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE --- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A --- PARTICULAR PURPOSE OF SAID MATERIAL. ---* --- --- OBJECTIVE: --- Check that operational items are allowed in some contexts where --- representation items are not: --- --- 1 - Check that the name of an incompletely defined type can be used --- when specifying an operational item. (RM95/TC1 7.3(5)). --- --- 2 - Check that operational items can be specified for a descendant of --- a generic formal untagged type. (RM95/TC1 13.1(10)). --- --- 3 - Check that operational items can be specified for a derived --- untagged type even if the parent type is a by-reference type or --- has user-defined primitive subprograms. (RM95/TC1 13.1(11/1)). --- --- (Defect Report 8652/0009, as reflected in Technical Corrigendum 1). --- --- CHANGE HISTORY: --- 19 JAN 2001 PHL Initial version. --- 3 DEC 2001 RLB Reformatted for ACATS. --- 3 OCT 2002 RLB Corrected incorrect type derivations. --- ---! -with Ada.Streams; -use Ada.Streams; -package CD10002_0 is - - type Kinds is (Read, Write, Input, Output); - type Counts is array (Kinds) of Natural; - - generic - type T is private; - package Nonlimited_Stream_Ops is - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T); - function Input (Stream : access Root_Stream_Type'Class) return T; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T); - procedure Output (Stream : access Root_Stream_Type'Class; Item : T); - - function Get_Counts return Counts; - - end Nonlimited_Stream_Ops; - - generic - type T (<>) is limited private; -- Should be self-initializing. - C : in out T; - package Limited_Stream_Ops is - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T); - function Input (Stream : access Root_Stream_Type'Class) return T; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T); - procedure Output (Stream : access Root_Stream_Type'Class; Item : T); - - function Get_Counts return Counts; - - end Limited_Stream_Ops; - -end CD10002_0; - - -package body CD10002_0 is - - package body Nonlimited_Stream_Ops is - Cnts : Counts := (others => 0); - X : T; -- Initialized by Write/Output. - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is - begin - X := Item; - Cnts (Write) := Cnts (Write) + 1; - end Write; - - function Input (Stream : access Root_Stream_Type'Class) return T is - begin - Cnts (Input) := Cnts (Input) + 1; - return X; - end Input; - - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is - begin - Cnts (Read) := Cnts (Read) + 1; - Item := X; - end Read; - - procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is - begin - X := Item; - Cnts (Output) := Cnts (Output) + 1; - end Output; - - function Get_Counts return Counts is - begin - return Cnts; - end Get_Counts; - - end Nonlimited_Stream_Ops; - - package body Limited_Stream_Ops is - Cnts : Counts := (others => 0); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is - begin - Cnts (Write) := Cnts (Write) + 1; - end Write; - - function Input (Stream : access Root_Stream_Type'Class) return T is - begin - Cnts (Input) := Cnts (Input) + 1; - return C; - end Input; - - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is - begin - Cnts (Read) := Cnts (Read) + 1; - end Read; - - procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is - begin - Cnts (Output) := Cnts (Output) + 1; - end Output; - - function Get_Counts return Counts is - begin - return Cnts; - end Get_Counts; - - end Limited_Stream_Ops; - -end CD10002_0; - - -with Ada.Streams; -use Ada.Streams; -package CD10002_1 is - - type Dummy_Stream is new Root_Stream_Type with null record; - procedure Read (Stream : in out Dummy_Stream; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset); - procedure Write (Stream : in out Dummy_Stream; - Item : Stream_Element_Array); - -end CD10002_1; - - -with Report; -use Report; -package body CD10002_1 is - - procedure Read (Stream : in out Dummy_Stream; - Item : out Stream_Element_Array; - Last : out Stream_Element_Offset) is - begin - Failed ("Unexpected call to the Read operation of Dummy_Stream"); - end Read; - - procedure Write (Stream : in out Dummy_Stream; - Item : Stream_Element_Array) is - begin - Failed ("Unexpected call to the Write operation of Dummy_Stream"); - end Write; - -end CD10002_1; - - -with Ada.Streams; -use Ada.Streams; -with CD10002_0; -package CD10002_Deriv is - - -- Parent has user-defined subprograms. - - type T1 is new Boolean; - function Is_Odd (X : Integer) return T1; - - type T2 is - record - F : Float; - end record; - procedure Print (X : T2); - - type T3 is array (Boolean) of Duration; - function "+" (L, R : T3) return T3; - - -- Parent is by-reference. No need to check the case where the parent - -- is tagged, because the defect report only deals with untagged types. - - task type T4 is - end T4; - - protected type T5 is - end T5; - - type T6 (D : access Integer := new Integer'(2)) is limited null record; - - type T7 is array (Character) of T6; - - package P is - type T8 is limited private; - private - type T8 is new T5; - end P; - - type Nt1 is new T1; - type Nt2 is new T2; - type Nt3 is new T3; - type Nt4 is new T4; - type Nt5 is new T5; - type Nt6 is new T6; - type Nt7 is new T7; - type Nt8 is new P.T8; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt1'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2); - function Input (Stream : access Root_Stream_Type'Class) return Nt2; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3); - function Input (Stream : access Root_Stream_Type'Class) return Nt3; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4); - function Input (Stream : access Root_Stream_Type'Class) return Nt4; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5); - function Input (Stream : access Root_Stream_Type'Class) return Nt5; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6); - function Input (Stream : access Root_Stream_Type'Class) return Nt6; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7); - function Input (Stream : access Root_Stream_Type'Class) return Nt7; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8); - function Input (Stream : access Root_Stream_Type'Class) return Nt8; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8); - - for Nt1'Write use Write; - for Nt1'Read use Read; - for Nt1'Output use Output; - for Nt1'Input use Input; - - for Nt2'Write use Write; - for Nt2'Read use Read; - for Nt2'Output use Output; - for Nt2'Input use Input; - - for Nt3'Write use Write; - for Nt3'Read use Read; - for Nt3'Output use Output; - for Nt3'Input use Input; - - for Nt4'Write use Write; - for Nt4'Read use Read; - for Nt4'Output use Output; - for Nt4'Input use Input; - - for Nt5'Write use Write; - for Nt5'Read use Read; - for Nt5'Output use Output; - for Nt5'Input use Input; - - for Nt6'Write use Write; - for Nt6'Read use Read; - for Nt6'Output use Output; - for Nt6'Input use Input; - - for Nt7'Write use Write; - for Nt7'Read use Read; - for Nt7'Output use Output; - for Nt7'Input use Input; - - for Nt8'Write use Write; - for Nt8'Read use Read; - for Nt8'Output use Output; - for Nt8'Input use Input; - - -- All these variables are self-initializing. - C4 : Nt4; - C5 : Nt5; - C6 : Nt6; - C7 : Nt7; - C8 : Nt8; - - package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base); - package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2); - package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3); - package Nt4_Ops is new CD10002_0.Limited_Stream_Ops (Nt4, C4); - package Nt5_Ops is new CD10002_0.Limited_Stream_Ops (Nt5, C5); - package Nt6_Ops is new CD10002_0.Limited_Stream_Ops (Nt6, C6); - package Nt7_Ops is new CD10002_0.Limited_Stream_Ops (Nt7, C7); - package Nt8_Ops is new CD10002_0.Limited_Stream_Ops (Nt8, C8); - -end CD10002_Deriv; - - -package body CD10002_Deriv is - - function Is_Odd (X : Integer) return T1 is - begin - return True; - end Is_Odd; - procedure Print (X : T2) is - begin - null; - end Print; - function "+" (L, R : T3) return T3 is - begin - return (False => L (False) + R (True), True => L (True) + R (False)); - end "+"; - task body T4 is - begin - null; - end T4; - protected body T5 is - end T5; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) - renames Nt1_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base - renames Nt1_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base) - renames Nt1_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) - renames Nt1_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2) - renames Nt2_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt2 - renames Nt2_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2) - renames Nt2_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2) - renames Nt2_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3) - renames Nt3_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt3 - renames Nt3_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3) - renames Nt3_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3) - renames Nt3_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4) - renames Nt4_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt4 - renames Nt4_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4) - renames Nt4_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4) - renames Nt4_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5) - renames Nt5_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt5 - renames Nt5_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5) - renames Nt5_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5) - renames Nt5_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6) - renames Nt6_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt6 - renames Nt6_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6) - renames Nt6_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6) - renames Nt6_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7) - renames Nt7_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt7 - renames Nt7_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7) - renames Nt7_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7) - renames Nt7_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8) - renames Nt8_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt8 - renames Nt8_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8) - renames Nt8_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8) - renames Nt8_Ops.Output; - -end CD10002_Deriv; - - -with Ada.Streams; -use Ada.Streams; -with CD10002_0; -generic - type T1 is (<>); - type T2 is range <>; - type T3 is mod <>; - type T4 is digits <>; - type T5 is delta <>; - type T6 is delta <> digits <>; - type T7 is access T3; - type T8 is new Boolean; - type T9 is private; - type T10 (<>) is limited private; -- Should be self-initializing. - C10 : in out T10; - type T11 is array (T1) of T2; -package CD10002_Gen is - - -- Direct descendants. - type Nt1 is new T1; - type Nt2 is new T2; - type Nt3 is new T3; - type Nt4 is new T4; - type Nt5 is new T5; - type Nt6 is new T6; - type Nt7 is new T7; - type Nt8 is new T8; - type Nt9 is new T9; - type Nt10 is new T10; - type Nt11 is new T11; - - -- Indirect descendants (only pick two, a limited one and a non-limited - -- one). - type Nt12 is new Nt10; - type Nt13 is new Nt11; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt1'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt2'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt3'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt4'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt5'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt6'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7); - function Input (Stream : access Root_Stream_Type'Class) return Nt7; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base); - function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base; - procedure Read (Stream : access Root_Stream_Type'Class; - Item : out Nt8'Base); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9); - function Input (Stream : access Root_Stream_Type'Class) return Nt9; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10); - function Input (Stream : access Root_Stream_Type'Class) return Nt10; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11); - function Input (Stream : access Root_Stream_Type'Class) return Nt11; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12); - function Input (Stream : access Root_Stream_Type'Class) return Nt12; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13); - function Input (Stream : access Root_Stream_Type'Class) return Nt13; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13); - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13); - - for Nt1'Write use Write; - for Nt1'Read use Read; - for Nt1'Output use Output; - for Nt1'Input use Input; - - for Nt2'Write use Write; - for Nt2'Read use Read; - for Nt2'Output use Output; - for Nt2'Input use Input; - - for Nt3'Write use Write; - for Nt3'Read use Read; - for Nt3'Output use Output; - for Nt3'Input use Input; - - for Nt4'Write use Write; - for Nt4'Read use Read; - for Nt4'Output use Output; - for Nt4'Input use Input; - - for Nt5'Write use Write; - for Nt5'Read use Read; - for Nt5'Output use Output; - for Nt5'Input use Input; - - for Nt6'Write use Write; - for Nt6'Read use Read; - for Nt6'Output use Output; - for Nt6'Input use Input; - - for Nt7'Write use Write; - for Nt7'Read use Read; - for Nt7'Output use Output; - for Nt7'Input use Input; - - for Nt8'Write use Write; - for Nt8'Read use Read; - for Nt8'Output use Output; - for Nt8'Input use Input; - - for Nt9'Write use Write; - for Nt9'Read use Read; - for Nt9'Output use Output; - for Nt9'Input use Input; - - for Nt10'Write use Write; - for Nt10'Read use Read; - for Nt10'Output use Output; - for Nt10'Input use Input; - - for Nt11'Write use Write; - for Nt11'Read use Read; - for Nt11'Output use Output; - for Nt11'Input use Input; - - for Nt12'Write use Write; - for Nt12'Read use Read; - for Nt12'Output use Output; - for Nt12'Input use Input; - - for Nt13'Write use Write; - for Nt13'Read use Read; - for Nt13'Output use Output; - for Nt13'Input use Input; - - type Null_Record is null record; - - package Nt1_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt1'Base); - package Nt2_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt2'Base); - package Nt3_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt3'Base); - package Nt4_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt4'Base); - package Nt5_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt5'Base); - package Nt6_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt6'Base); - package Nt7_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt7); - package Nt8_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt8'Base); - package Nt9_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt9); - package Nt11_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt11); - package Nt13_Ops is new CD10002_0.Nonlimited_Stream_Ops (Nt13); - - function Get_Nt10_Counts return CD10002_0.Counts; - function Get_Nt12_Counts return CD10002_0.Counts; - -end CD10002_Gen; - - -package body CD10002_Gen is - - use CD10002_0; - - Nt10_Cnts : Counts := (others => 0); - Nt12_Cnts : Counts := (others => 0); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) - renames Nt1_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt1'Base - renames Nt1_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt1'Base) - renames Nt1_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt1'Base) - renames Nt1_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt2'Base) - renames Nt2_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt2'Base - renames Nt2_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt2'Base) - renames Nt2_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt2'Base) - renames Nt2_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt3'Base) - renames Nt3_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt3'Base - renames Nt3_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt3'Base) - renames Nt3_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt3'Base) - renames Nt3_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt4'Base) - renames Nt4_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt4'Base - renames Nt4_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt4'Base) - renames Nt4_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt4'Base) - renames Nt4_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt5'Base) - renames Nt5_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt5'Base - renames Nt5_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt5'Base) - renames Nt5_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt5'Base) - renames Nt5_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt6'Base) - renames Nt6_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt6'Base - renames Nt6_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt6'Base) - renames Nt6_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt6'Base) - renames Nt6_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt7) - renames Nt7_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt7 - renames Nt7_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt7) - renames Nt7_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt7) - renames Nt7_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt8'Base) - renames Nt8_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt8'Base - renames Nt8_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt8'Base) - renames Nt8_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt8'Base) - renames Nt8_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt9) - renames Nt9_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt9 - renames Nt9_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt9) - renames Nt9_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt9) - renames Nt9_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt10) is - begin - Nt10_Cnts (Write) := Nt10_Cnts (Write) + 1; - end Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt10 is - begin - Nt10_Cnts (Input) := Nt10_Cnts (Input) + 1; - return Nt10 (C10); - end Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt10) is - begin - Nt10_Cnts (Read) := Nt10_Cnts (Read) + 1; - end Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt10) is - begin - Nt10_Cnts (Output) := Nt10_Cnts (Output) + 1; - end Output; - function Get_Nt10_Counts return CD10002_0.Counts is - begin - return Nt10_Cnts; - end Get_Nt10_Counts; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt11) - renames Nt11_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt11 - renames Nt11_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt11) - renames Nt11_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt11) - renames Nt11_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt12) is - begin - Nt12_Cnts (Write) := Nt12_Cnts (Write) + 1; - end Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt12 is - begin - Nt12_Cnts (Input) := Nt12_Cnts (Input) + 1; - return Nt12 (C10); - end Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt12) is - begin - Nt12_Cnts (Read) := Nt12_Cnts (Read) + 1; - end Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt12) is - begin - Nt12_Cnts (Output) := Nt12_Cnts (Output) + 1; - end Output; - function Get_Nt12_Counts return CD10002_0.Counts is - begin - return Nt12_Cnts; - end Get_Nt12_Counts; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : Nt13) - renames Nt13_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return Nt13 - renames Nt13_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out Nt13) - renames Nt13_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : Nt13) - renames Nt13_Ops.Output; - -end CD10002_Gen; - - -with Ada.Streams; -use Ada.Streams; -with CD10002_0; -package CD10002_Priv is - - External_Tag_1 : constant String := "Isaac Newton"; - External_Tag_2 : constant String := "Albert Einstein"; - - type T1 is tagged private; - type T2 is tagged - record - C : T1; - end record; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T1); - function Input (Stream : access Root_Stream_Type'Class) return T1; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1); - procedure Output (Stream : access Root_Stream_Type'Class; Item : T1); - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T2); - function Input (Stream : access Root_Stream_Type'Class) return T2; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2); - procedure Output (Stream : access Root_Stream_Type'Class; Item : T2); - - for T1'Write use Write; - for T1'Input use Input; - - for T2'Read use Read; - for T2'Output use Output; - for T2'External_Tag use External_Tag_2; - - function Get_T1_Counts return CD10002_0.Counts; - function Get_T2_Counts return CD10002_0.Counts; - -private - - for T1'Read use Read; - for T1'Output use Output; - for T1'External_Tag use External_Tag_1; - - for T2'Write use Write; - for T2'Input use Input; - - type T1 is tagged null record; - - package T1_Ops is new CD10002_0.Nonlimited_Stream_Ops (T1); - package T2_Ops is new CD10002_0.Nonlimited_Stream_Ops (T2); - -end CD10002_Priv; - - -package body CD10002_Priv is - procedure Write (Stream : access Root_Stream_Type'Class; Item : T1) - renames T1_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return T1 - renames T1_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T1) - renames T1_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : T1) - renames T1_Ops.Output; - - procedure Write (Stream : access Root_Stream_Type'Class; Item : T2) - renames T2_Ops.Write; - function Input (Stream : access Root_Stream_Type'Class) return T2 - renames T2_Ops.Input; - procedure Read (Stream : access Root_Stream_Type'Class; Item : out T2) - renames T2_Ops.Read; - procedure Output (Stream : access Root_Stream_Type'Class; Item : T2) - renames T2_Ops.Output; - - function Get_T1_Counts return CD10002_0.Counts renames T1_Ops.Get_Counts; - function Get_T2_Counts return CD10002_0.Counts renames T2_Ops.Get_Counts; -end CD10002_Priv; - - -with Ada.Streams; -use Ada.Streams; -with Report; -use Report; -with System; -with CD10002_0; -with CD10002_1; -with CD10002_Deriv; -with CD10002_Gen; -with CD10002_Priv; -procedure CD10002 is - - package Deriv renames CD10002_Deriv; - generic package Gen renames CD10002_Gen; - package Priv renames CD10002_Priv; - - type Stream_Ops is (Read, Write, Input, Output); - type Counts is array (Stream_Ops) of Natural; - - S : aliased CD10002_1.Dummy_Stream; - -begin - Test ("CD10002", - "Check that operational items are allowed in some contexts " & - "where representation items are not"); - - Test_Priv: - declare - X1 : Priv.T1; - X2 : Priv.T2; - use CD10002_0; - begin - Comment - ("Check that the name of an incompletely defined type can be " & - "used when specifying an operational item"); - - -- Partial view of a private type. - Priv.T1'Write (S'Access, X1); - Priv.T1'Read (S'Access, X1); - Priv.T1'Output (S'Access, X1); - X1 := Priv.T1'Input (S'Access); - - if Priv.Get_T1_Counts /= (1, 1, 1, 1) then - Failed ("Incorrect calls to the stream attributes for Priv.T1"); - elsif Priv.T1'External_Tag /= Priv.External_Tag_1 then - Failed ("Incorrect external tag for Priv.T1"); - end if; - - -- Incompletely defined but not private. - Priv.T2'Write (S'Access, X2); - Priv.T2'Read (S'Access, X2); - Priv.T2'Output (S'Access, X2); - X2 := Priv.T2'Input (S'Access); - - if Priv.Get_T2_Counts /= (1, 1, 1, 1) then - Failed ("Incorrect calls to the stream attributes for Priv.T2"); - elsif Priv.T2'External_Tag /= Priv.External_Tag_2 then - Failed ("Incorrect external tag for Priv.T2"); - end if; - - end Test_Priv; - - Test_Gen: - declare - - type Modular is mod System.Max_Binary_Modulus; - type Decimal is delta 1.0 digits 1; - type Access_Modular is access Modular; - type R9 is null record; - type R10 (D : access Integer) is limited null record; - type Arr is array (Character) of Integer; - - C10 : R10 (new Integer'(19)); - - package Inst is new Gen (T1 => Character, - T2 => Integer, - T3 => Modular, - T4 => Float, - T5 => Duration, - T6 => Decimal, - T7 => Access_Modular, - T8 => Boolean, - T9 => R9, - T10 => R10, - C10 => C10, - T11 => Arr); - - X1 : Inst.Nt1 := 'a'; - X2 : Inst.Nt2 := 0; - X3 : Inst.Nt3 := 0; - X4 : Inst.Nt4 := 0.0; - X5 : Inst.Nt5 := 0.0; - X6 : Inst.Nt6 := 0.0; - X7 : Inst.Nt7 := null; - X8 : Inst.Nt8 := Inst.False; - X9 : Inst.Nt9 := (null record); - X10 : Inst.Nt10 (D => new Integer'(5)); - Y10 : Integer; - X11 : Inst.Nt11 := (others => 0); - X12 : Inst.Nt12 (D => new Integer'(7)); - Y12 : Integer; - X13 : Inst.Nt13 := (others => 0); - use CD10002_0; - begin - Comment ("Check that operational items can be specified for a " & - "descendant of a generic formal untagged type"); - - Inst.Nt1'Write (S'Access, X1); - Inst.Nt1'Read (S'Access, X1); - Inst.Nt1'Output (S'Access, X1); - X1 := Inst.Nt1'Input (S'Access); - - if Inst.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt1"); - end if; - - Inst.Nt2'Write (S'Access, X2); - Inst.Nt2'Read (S'Access, X2); - Inst.Nt2'Output (S'Access, X2); - X2 := Inst.Nt2'Input (S'Access); - - if Inst.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt2"); - end if; - - Inst.Nt3'Write (S'Access, X3); - Inst.Nt3'Read (S'Access, X3); - Inst.Nt3'Output (S'Access, X3); - X3 := Inst.Nt3'Input (S'Access); - - if Inst.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt3"); - end if; - - Inst.Nt4'Write (S'Access, X4); - Inst.Nt4'Read (S'Access, X4); - Inst.Nt4'Output (S'Access, X4); - X4 := Inst.Nt4'Input (S'Access); - - if Inst.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt4"); - end if; - - Inst.Nt5'Write (S'Access, X5); - Inst.Nt5'Read (S'Access, X5); - Inst.Nt5'Output (S'Access, X5); - X5 := Inst.Nt5'Input (S'Access); - - if Inst.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt5"); - end if; - - Inst.Nt6'Write (S'Access, X6); - Inst.Nt6'Read (S'Access, X6); - Inst.Nt6'Output (S'Access, X6); - X6 := Inst.Nt6'Input (S'Access); - - if Inst.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt6"); - end if; - - Inst.Nt7'Write (S'Access, X7); - Inst.Nt7'Read (S'Access, X7); - Inst.Nt7'Output (S'Access, X7); - X7 := Inst.Nt7'Input (S'Access); - - if Inst.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt7"); - end if; - - Inst.Nt8'Write (S'Access, X8); - Inst.Nt8'Read (S'Access, X8); - Inst.Nt8'Output (S'Access, X8); - X8 := Inst.Nt8'Input (S'Access); - - if Inst.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt8"); - end if; - - Inst.Nt9'Write (S'Access, X9); - Inst.Nt9'Read (S'Access, X9); - Inst.Nt9'Output (S'Access, X9); - X9 := Inst.Nt9'Input (S'Access); - - if Inst.Nt9_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt9"); - end if; - - Inst.Nt10'Write (S'Access, X10); - Inst.Nt10'Read (S'Access, X10); - Inst.Nt10'Output (S'Access, X10); - Y10 := Inst.Nt10'Input (S'Access).D.all; - - if Inst.Get_Nt10_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt10"); - end if; - - Inst.Nt11'Write (S'Access, X11); - Inst.Nt11'Read (S'Access, X11); - Inst.Nt11'Output (S'Access, X11); - X11 := Inst.Nt11'Input (S'Access); - - if Inst.Nt11_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt11"); - end if; - - Inst.Nt12'Write (S'Access, X12); - Inst.Nt12'Read (S'Access, X12); - Inst.Nt12'Output (S'Access, X12); - Y12 := Inst.Nt12'Input (S'Access).D.all; - - if Inst.Get_Nt12_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt12"); - end if; - - Inst.Nt13'Write (S'Access, X13); - Inst.Nt13'Read (S'Access, X13); - Inst.Nt13'Output (S'Access, X13); - X13 := Inst.Nt13'Input (S'Access); - - if Inst.Nt13_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Inst.Nt13"); - end if; - end Test_Gen; - - Test_Deriv: - declare - X1 : Deriv.Nt1 := Deriv.False; - X2 : Deriv.Nt2 := (others => 0.0); - X3 : Deriv.Nt3 := (others => 0.0); - X4 : Deriv.Nt4; - Y4 : Boolean; - X5 : Deriv.Nt5; - Y5 : System.Address; - X6 : Deriv.Nt6; - Y6 : Integer; - X7 : Deriv.Nt7; - Y7 : Integer; - X8 : Deriv.Nt8; - Y8 : Integer; - use CD10002_0; - begin - Comment ("Check that operational items can be specified for a " & - "derived untagged type even if the parent type is a " & - "by-reference type, or has user-defined primitive " & - "subprograms"); - - Deriv.Nt1'Write (S'Access, X1); - Deriv.Nt1'Read (S'Access, X1); - Deriv.Nt1'Output (S'Access, X1); - X1 := Deriv.Nt1'Input (S'Access); - - if Deriv.Nt1_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt1"); - end if; - - Deriv.Nt2'Write (S'Access, X2); - Deriv.Nt2'Read (S'Access, X2); - Deriv.Nt2'Output (S'Access, X2); - X2 := Deriv.Nt2'Input (S'Access); - - if Deriv.Nt2_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt2"); - end if; - - Deriv.Nt3'Write (S'Access, X3); - Deriv.Nt3'Read (S'Access, X3); - Deriv.Nt3'Output (S'Access, X3); - X3 := Deriv.Nt3'Input (S'Access); - - if Deriv.Nt3_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt3"); - end if; - - Deriv.Nt4'Write (S'Access, X4); - Deriv.Nt4'Read (S'Access, X4); - Deriv.Nt4'Output (S'Access, X4); - Y4 := Deriv.Nt4'Input (S'Access)'Terminated; - - if Deriv.Nt4_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt4"); - end if; - - Deriv.Nt5'Write (S'Access, X5); - Deriv.Nt5'Read (S'Access, X5); - Deriv.Nt5'Output (S'Access, X5); - Y5 := Deriv.Nt5'Input (S'Access)'Address; - - if Deriv.Nt5_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt5"); - end if; - - Deriv.Nt6'Write (S'Access, X6); - Deriv.Nt6'Read (S'Access, X6); - Deriv.Nt6'Output (S'Access, X6); - Y6 := Deriv.Nt6'Input (S'Access).D.all; - - if Deriv.Nt6_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt6"); - end if; - - Deriv.Nt7'Write (S'Access, X7); - Deriv.Nt7'Read (S'Access, X7); - Deriv.Nt7'Output (S'Access, X7); - Y7 := Deriv.Nt7'Input (S'Access) ('a').D.all; - - if Deriv.Nt7_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt7"); - end if; - - Deriv.Nt8'Write (S'Access, X8); - Deriv.Nt8'Read (S'Access, X8); - Deriv.Nt8'Output (S'Access, X8); - Y8 := Deriv.Nt8'Input (S'Access)'Size; - - if Deriv.Nt8_Ops.Get_Counts /= (1, 1, 1, 1) then - Failed - ("Incorrect calls to the stream attributes for Deriv.Nt8"); - end if; - end Test_Deriv; - - Result; -end CD10002; - - |