-- 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;