URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cdd2a02.a] - Blame information for rev 720

Details | Compare with Previous | View Log


-- CDD2A02.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 the Read, Write, Input, and Output attributes are inherited
--    for untagged derived types.  (Defect Report 8652/0040,
--     as reflected in Technical Corrigendum 1, 13.13.2(8.1/1) and
--     13.13.2(25/1)).
--
-- CHANGE HISTORY:
--    30 JUL 2001   PHL   Initial version.
--     5 DEC 2001   RLB   Reformatted for ACATS.
--
--!
with Ada.Streams;
use Ada.Streams;
with FDD2A00;
use FDD2A00;
with Report;
use Report;
procedure CDD2A02 is
 
    type Int is range 1 .. 10;
    type Str is array (Int range <>) of Character;
 
    procedure Read (Stream : access Root_Stream_Type'Class;
                    Item : out Int'Base);
    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);
    function Input (Stream : access Root_Stream_Type'Class) return Int'Base;
    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);
 
    for Int'Read use Read;
    for Int'Write use Write;
    for Int'Input use Input;
    for Int'Output use Output;
 
 
    type Parent (D1, D2 : Int; B : Boolean) is
        record
            S : Str (D1 .. D2);
            case B is
                when False =>
                    C1 : Integer;
                when True =>
                    C2 : Float;
            end case;
        end record;
 
    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);
    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);
    function Input (Stream : access Root_Stream_Type'Class) return Parent;
    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);
 
    for Parent'Read use Read;
    for Parent'Write use Write;
    for Parent'Input use Input;
    for Parent'Output use Output;
 
 
    procedure Actual_Read
                 (Stream : access Root_Stream_Type'Class; Item : out Int) is
    begin
        Integer'Read (Stream, Integer (Item));
    end Actual_Read;
 
    procedure Actual_Write
                 (Stream : access Root_Stream_Type'Class; Item : Int) is
    begin
        Integer'Write (Stream, Integer (Item));
    end Actual_Write;
 
    function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is
    begin
        return Int (Integer'Input (Stream));
    end Actual_Input;
 
    procedure Actual_Output
                 (Stream : access Root_Stream_Type'Class; Item : Int) is
    begin
        Integer'Output (Stream, Integer (Item));
    end Actual_Output;
 
 
    procedure Actual_Read
                 (Stream : access Root_Stream_Type'Class; Item : out Parent) is
    begin
        case Item.B is
            when False =>
                Item.C1 := 7;
            when True =>
                Float'Read (Stream, Item.C2);
        end case;
        Str'Read (Stream, Item.S);
    end Actual_Read;
 
    procedure Actual_Write
                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
    begin
        case Item.B is
            when False =>
                null; -- Don't write C1
            when True =>
                Float'Write (Stream, Item.C2);
        end case;
        Str'Write (Stream, Item.S);
    end Actual_Write;
 
    function Actual_Input
                (Stream : access Root_Stream_Type'Class) return Parent is
        D1, D2 : Int;
        B : Boolean;
    begin
        Int'Read (Stream, D2);
        Boolean'Read (Stream, B);
        Int'Read (Stream, D1);
 
        declare
            Item : Parent (D1 => D1, D2 => D2, B => B);
        begin
            Parent'Read (Stream, Item);
            return Item;
        end;
 
    end Actual_Input;
 
    procedure Actual_Output
                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
    begin
        Int'Write (Stream, Item.D2);
        Boolean'Write (Stream, Item.B);
        Int'Write (Stream, Item.D1);
        Parent'Write (Stream, Item);
    end Actual_Output;
 
    package Int_Ops is new Counting_Stream_Ops (T => Int'Base,
                                                Actual_Write => Actual_Write,
                                                Actual_Input => Actual_Input,
                                                Actual_Read => Actual_Read,
                                                Actual_Output => Actual_Output);
 
    package Parent_Ops is
       new Counting_Stream_Ops (T => Parent,
                                Actual_Write => Actual_Write,
                                Actual_Input => Actual_Input,
                                Actual_Read => Actual_Read,
                                Actual_Output => Actual_Output);
 
    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)
       renames Int_Ops.Read;
    procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)
       renames Int_Ops.Write;
    function Input (Stream : access Root_Stream_Type'Class) return Int'Base
       renames Int_Ops.Input;
    procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)
       renames Int_Ops.Output;
 
    procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)
       renames Parent_Ops.Read;
    procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)
       renames Parent_Ops.Write;
    function Input (Stream : access Root_Stream_Type'Class) return Parent
       renames Parent_Ops.Input;
    procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)
       renames Parent_Ops.Output;
 
begin
    Test ("CDD2A02", "Check that the Read, Write, Input, and Output " &
                     "attributes are inherited for untagged derived types");
 
    Test1:
        declare
            type Derived1 is new Parent;
            S : aliased My_Stream (1000);
            X1 : Derived1 (D1 => Int (Ident_Int (2)),
                           D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
            Y1 : Derived1 := (D1 => 3,
                              D2 => 6,
                              B => False,
                              S => Str (Ident_Str ("3456")),
                              C1 => Ident_Int (100));
            X2 : Derived1 (D1 => Int (Ident_Int (2)),
                           D2 => Int (Ident_Int (5)), B => Ident_Bool (True));
        begin
            X1.S := Str (Ident_Str ("bcde"));
            X1.C2 := Float (Ident_Int (4));
 
            Derived1'Write (S'Access, X1);
            if Int_Ops.Get_Counts /=
               (Read => 0, Write => 0, Input => 0, Output => 0) then
                Failed ("Error writing discriminants - 1");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 0, Write => 1, Input => 0, Output => 0) then
                Failed ("Didn't call inherited Write - 1");
            end if;
 
            Derived1'Read (S'Access, X2);
            if Int_Ops.Get_Counts /=
               (Read => 0, Write => 0, Input => 0, Output => 0) then
                Failed ("Error reading discriminants - 1");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 1, Write => 1, Input => 0, Output => 0) then
                Failed ("Didn't call inherited Read - 1");
            end if;
 
            if X2 /= (D1 => 2,
                      D2 => 5,
                      B => True,
                      S => Str (Ident_Str ("bcde")),
                      C2 => Float (Ident_Int (4))) then
                Failed
                   ("Inherited Read and Write are not inverses of each other - 1");
            end if;
 
            Derived1'Output (S'Access, Y1);
            if Int_Ops.Get_Counts /=
               (Read => 0, Write => 2, Input => 0, Output => 0) then
                Failed ("Error writing discriminants - 2");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 1, Write => 2, Input => 0, Output => 1) then
                Failed ("Didn't call inherited Output - 2");
            end if;
 
            declare
                Y2 : Derived1 := Derived1'Input (S'Access);
            begin
                if Int_Ops.Get_Counts /=
                   (Read => 2, Write => 2, Input => 0, Output => 0) then
                    Failed ("Error reading discriminants - 2");
                end if;
                if Parent_Ops.Get_Counts /=
                   (Read => 2, Write => 2, Input => 1, Output => 1) then
                    Failed ("Didn't call inherited Input - 2");
                end if;
 
                if Y2 /= (D1 => 3,
                          D2 => 6,
                          B => False,
                          S => Str (Ident_Str ("3456")),
                          C1 => Ident_Int (7)) then
                    Failed
                       ("Inherited Input and Output are not inverses of each other - 2");
                end if;
            end;
        end Test1;
 
    Test2:
        declare
            type Derived2 (D : Int) is new Parent (D1 => D,
                                                   D2 => D,
                                                   B => False);
            S : aliased My_Stream (1000);
            X1 : Derived2 (D => Int (Ident_Int (7)));
            Y1 : Derived2 := (D => 8,
                              S => Str (Ident_Str ("8")),
                              C1 => Ident_Int (200));
            X2 : Derived2 (D => Int (Ident_Int (7)));
        begin
            X1.S := Str (Ident_Str ("g"));
            X1.C1 := Ident_Int (4);
 
            Derived2'Write (S'Access, X1);
            if Int_Ops.Get_Counts /=
               (Read => 2, Write => 2, Input => 0, Output => 0) then
                Failed ("Error writing discriminants - 3");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 2, Write => 3, Input => 1, Output => 1) then
                Failed ("Didn't call inherited Write - 3");
            end if;
 
            Derived2'Read (S'Access, X2);
            if Int_Ops.Get_Counts /=
               (Read => 2, Write => 2, Input => 0, Output => 0) then
                Failed ("Error reading discriminants - 3");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 3, Write => 3, Input => 1, Output => 1) then
                Failed ("Didn't call inherited Read - 3");
            end if;
 
            if X2 /= (D => 7,
                      S => Str (Ident_Str ("g")),
                      C1 => Ident_Int (7)) then
                Failed
                   ("Inherited Read and Write are not inverses of each other - 3");
            end if;
 
            Derived2'Output (S'Access, Y1);
            if Int_Ops.Get_Counts /=
               (Read => 2, Write => 4, Input => 0, Output => 0) then
                Failed ("Error writing discriminants - 4");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 3, Write => 4, Input => 1, Output => 2) then
                Failed ("Didn't call inherited Output - 4");
            end if;
 
            declare
                Y2 : Derived2 := Derived2'Input (S'Access);
            begin
                if Int_Ops.Get_Counts /=
                   (Read => 4, Write => 4, Input => 0, Output => 0) then
                    Failed ("Error reading discriminants - 4");
                end if;
                if Parent_Ops.Get_Counts /=
                   (Read => 4, Write => 4, Input => 2, Output => 2) then
                    Failed ("Didn't call inherited Input - 4");
                end if;
 
                if Y2 /= (D => 8,
                          S => Str (Ident_Str ("8")),
                          C1 => Ident_Int (7)) then
                    Failed
                       ("Inherited Input and Output are not inverses of each other - 4");
                end if;
            end;
        end Test2;
 
    Result;
end CDD2A02;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cd/] [cdd2a02.a] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- CDD2A02.A`
2			`--`
3			`-- Grant of Unlimited Rights`
4			`--`
5			`-- The Ada Conformity Assessment Authority (ACAA) holds unlimited`
6			`-- rights in the software and documentation contained herein. Unlimited`
7			`-- rights are the same as those granted by the U.S. Government for older`
8			`-- parts of the Ada Conformity Assessment Test Suite, and are defined`
9			`-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA`
10			`-- intends to confer upon all recipients unlimited rights equal to those`
11			`-- held by the ACAA. These rights include rights to use, duplicate,`
12			`-- release or disclose the released technical data and computer software`
13			`-- in whole or in part, in any manner and for any purpose whatsoever, and`
14			`-- to have or permit others to do so.`
15			`--`
16			`-- DISCLAIMER`
17			`--`
18			`-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR`
19			`-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED`
20			`-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE`
21			`-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE`
22			`-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A`
23			`-- PARTICULAR PURPOSE OF SAID MATERIAL.`
24			`--*`
25			`--`
26			`-- OBJECTIVE:`
27			`-- Check that the Read, Write, Input, and Output attributes are inherited`
28			`-- for untagged derived types. (Defect Report 8652/0040,`
29			`-- as reflected in Technical Corrigendum 1, 13.13.2(8.1/1) and`
30			`-- 13.13.2(25/1)).`
31			`--`
32			`-- CHANGE HISTORY:`
33			`-- 30 JUL 2001 PHL Initial version.`
34			`-- 5 DEC 2001 RLB Reformatted for ACATS.`
35			`--`
36			`--!`
37			`with Ada.Streams;`
38			`use Ada.Streams;`
39			`with FDD2A00;`
40			`use FDD2A00;`
41			`with Report;`
42			`use Report;`
43			`procedure CDD2A02 is`
44
45			`type Int is range 1 .. 10;`
46			`type Str is array (Int range <>) of Character;`
47
48			`procedure Read (Stream : access Root_Stream_Type'Class;`
49			`Item : out Int'Base);`
50			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);`
51			`function Input (Stream : access Root_Stream_Type'Class) return Int'Base;`
52			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);`
53
54			`for Int'Read use Read;`
55			`for Int'Write use Write;`
56			`for Int'Input use Input;`
57			`for Int'Output use Output;`
58
59
60			`type Parent (D1, D2 : Int; B : Boolean) is`
61			`record`
62			`S : Str (D1 .. D2);`
63			`case B is`
64			`when False =>`
65			`C1 : Integer;`
66			`when True =>`
67			`C2 : Float;`
68			`end case;`
69			`end record;`
70
71			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);`
72			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);`
73			`function Input (Stream : access Root_Stream_Type'Class) return Parent;`
74			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);`
75
76			`for Parent'Read use Read;`
77			`for Parent'Write use Write;`
78			`for Parent'Input use Input;`
79			`for Parent'Output use Output;`
80
81
82			`procedure Actual_Read`
83			`(Stream : access Root_Stream_Type'Class; Item : out Int) is`
84			`begin`
85			`Integer'Read (Stream, Integer (Item));`
86			`end Actual_Read;`
87
88			`procedure Actual_Write`
89			`(Stream : access Root_Stream_Type'Class; Item : Int) is`
90			`begin`
91			`Integer'Write (Stream, Integer (Item));`
92			`end Actual_Write;`
93
94			`function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is`
95			`begin`
96			`return Int (Integer'Input (Stream));`
97			`end Actual_Input;`
98
99			`procedure Actual_Output`
100			`(Stream : access Root_Stream_Type'Class; Item : Int) is`
101			`begin`
102			`Integer'Output (Stream, Integer (Item));`
103			`end Actual_Output;`
104
105
106			`procedure Actual_Read`
107			`(Stream : access Root_Stream_Type'Class; Item : out Parent) is`
108			`begin`
109			`case Item.B is`
110			`when False =>`
111			`Item.C1 := 7;`
112			`when True =>`
113			`Float'Read (Stream, Item.C2);`
114			`end case;`
115			`Str'Read (Stream, Item.S);`
116			`end Actual_Read;`
117
118			`procedure Actual_Write`
119			`(Stream : access Root_Stream_Type'Class; Item : Parent) is`
120			`begin`
121			`case Item.B is`
122			`when False =>`
123			`null; -- Don't write C1`
124			`when True =>`
125			`Float'Write (Stream, Item.C2);`
126			`end case;`
127			`Str'Write (Stream, Item.S);`
128			`end Actual_Write;`
129
130			`function Actual_Input`
131			`(Stream : access Root_Stream_Type'Class) return Parent is`
132			`D1, D2 : Int;`
133			`B : Boolean;`
134			`begin`
135			`Int'Read (Stream, D2);`
136			`Boolean'Read (Stream, B);`
137			`Int'Read (Stream, D1);`
138
139			`declare`
140			`Item : Parent (D1 => D1, D2 => D2, B => B);`
141			`begin`
142			`Parent'Read (Stream, Item);`
143			`return Item;`
144			`end;`
145
146			`end Actual_Input;`
147
148			`procedure Actual_Output`
149			`(Stream : access Root_Stream_Type'Class; Item : Parent) is`
150			`begin`
151			`Int'Write (Stream, Item.D2);`
152			`Boolean'Write (Stream, Item.B);`
153			`Int'Write (Stream, Item.D1);`
154			`Parent'Write (Stream, Item);`
155			`end Actual_Output;`
156
157			`package Int_Ops is new Counting_Stream_Ops (T => Int'Base,`
158			`Actual_Write => Actual_Write,`
159			`Actual_Input => Actual_Input,`
160			`Actual_Read => Actual_Read,`
161			`Actual_Output => Actual_Output);`
162
163			`package Parent_Ops is`
164			`new Counting_Stream_Ops (T => Parent,`
165			`Actual_Write => Actual_Write,`
166			`Actual_Input => Actual_Input,`
167			`Actual_Read => Actual_Read,`
168			`Actual_Output => Actual_Output);`
169
170			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)`
171			`renames Int_Ops.Read;`
172			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)`
173			`renames Int_Ops.Write;`
174			`function Input (Stream : access Root_Stream_Type'Class) return Int'Base`
175			`renames Int_Ops.Input;`
176			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)`
177			`renames Int_Ops.Output;`
178
179			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)`
180			`renames Parent_Ops.Read;`
181			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)`
182			`renames Parent_Ops.Write;`
183			`function Input (Stream : access Root_Stream_Type'Class) return Parent`
184			`renames Parent_Ops.Input;`
185			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)`
186			`renames Parent_Ops.Output;`
187
188			`begin`
189			`Test ("CDD2A02", "Check that the Read, Write, Input, and Output " &`
190			`"attributes are inherited for untagged derived types");`
191
192			`Test1:`
193			`declare`
194			`type Derived1 is new Parent;`
195			`S : aliased My_Stream (1000);`
196			`X1 : Derived1 (D1 => Int (Ident_Int (2)),`
197			`D2 => Int (Ident_Int (5)), B => Ident_Bool (True));`
198			`Y1 : Derived1 := (D1 => 3,`
199			`D2 => 6,`
200			`B => False,`
201			`S => Str (Ident_Str ("3456")),`
202			`C1 => Ident_Int (100));`
203			`X2 : Derived1 (D1 => Int (Ident_Int (2)),`
204			`D2 => Int (Ident_Int (5)), B => Ident_Bool (True));`
205			`begin`
206			`X1.S := Str (Ident_Str ("bcde"));`
207			`X1.C2 := Float (Ident_Int (4));`
208
209			`Derived1'Write (S'Access, X1);`
210			`if Int_Ops.Get_Counts /=`
211			`(Read => 0, Write => 0, Input => 0, Output => 0) then`
212			`Failed ("Error writing discriminants - 1");`
213			`end if;`
214			`if Parent_Ops.Get_Counts /=`
215			`(Read => 0, Write => 1, Input => 0, Output => 0) then`
216			`Failed ("Didn't call inherited Write - 1");`
217			`end if;`
218
219			`Derived1'Read (S'Access, X2);`
220			`if Int_Ops.Get_Counts /=`
221			`(Read => 0, Write => 0, Input => 0, Output => 0) then`
222			`Failed ("Error reading discriminants - 1");`
223			`end if;`
224			`if Parent_Ops.Get_Counts /=`
225			`(Read => 1, Write => 1, Input => 0, Output => 0) then`
226			`Failed ("Didn't call inherited Read - 1");`
227			`end if;`
228
229			`if X2 /= (D1 => 2,`
230			`D2 => 5,`
231			`B => True,`
232			`S => Str (Ident_Str ("bcde")),`
233			`C2 => Float (Ident_Int (4))) then`
234			`Failed`
235			`("Inherited Read and Write are not inverses of each other - 1");`
236			`end if;`
237
238			`Derived1'Output (S'Access, Y1);`
239			`if Int_Ops.Get_Counts /=`
240			`(Read => 0, Write => 2, Input => 0, Output => 0) then`
241			`Failed ("Error writing discriminants - 2");`
242			`end if;`
243			`if Parent_Ops.Get_Counts /=`
244			`(Read => 1, Write => 2, Input => 0, Output => 1) then`
245			`Failed ("Didn't call inherited Output - 2");`
246			`end if;`
247
248			`declare`
249			`Y2 : Derived1 := Derived1'Input (S'Access);`
250			`begin`
251			`if Int_Ops.Get_Counts /=`
252			`(Read => 2, Write => 2, Input => 0, Output => 0) then`
253			`Failed ("Error reading discriminants - 2");`
254			`end if;`
255			`if Parent_Ops.Get_Counts /=`
256			`(Read => 2, Write => 2, Input => 1, Output => 1) then`
257			`Failed ("Didn't call inherited Input - 2");`
258			`end if;`
259
260			`if Y2 /= (D1 => 3,`
261			`D2 => 6,`
262			`B => False,`
263			`S => Str (Ident_Str ("3456")),`
264			`C1 => Ident_Int (7)) then`
265			`Failed`
266			`("Inherited Input and Output are not inverses of each other - 2");`
267			`end if;`
268			`end;`
269			`end Test1;`
270
271			`Test2:`
272			`declare`
273			`type Derived2 (D : Int) is new Parent (D1 => D,`
274			`D2 => D,`
275			`B => False);`
276			`S : aliased My_Stream (1000);`
277			`X1 : Derived2 (D => Int (Ident_Int (7)));`
278			`Y1 : Derived2 := (D => 8,`
279			`S => Str (Ident_Str ("8")),`
280			`C1 => Ident_Int (200));`
281			`X2 : Derived2 (D => Int (Ident_Int (7)));`
282			`begin`
283			`X1.S := Str (Ident_Str ("g"));`
284			`X1.C1 := Ident_Int (4);`
285
286			`Derived2'Write (S'Access, X1);`
287			`if Int_Ops.Get_Counts /=`
288			`(Read => 2, Write => 2, Input => 0, Output => 0) then`
289			`Failed ("Error writing discriminants - 3");`
290			`end if;`
291			`if Parent_Ops.Get_Counts /=`
292			`(Read => 2, Write => 3, Input => 1, Output => 1) then`
293			`Failed ("Didn't call inherited Write - 3");`
294			`end if;`
295
296			`Derived2'Read (S'Access, X2);`
297			`if Int_Ops.Get_Counts /=`
298			`(Read => 2, Write => 2, Input => 0, Output => 0) then`
299			`Failed ("Error reading discriminants - 3");`
300			`end if;`
301			`if Parent_Ops.Get_Counts /=`
302			`(Read => 3, Write => 3, Input => 1, Output => 1) then`
303			`Failed ("Didn't call inherited Read - 3");`
304			`end if;`
305
306			`if X2 /= (D => 7,`
307			`S => Str (Ident_Str ("g")),`
308			`C1 => Ident_Int (7)) then`
309			`Failed`
310			`("Inherited Read and Write are not inverses of each other - 3");`
311			`end if;`
312
313			`Derived2'Output (S'Access, Y1);`
314			`if Int_Ops.Get_Counts /=`
315			`(Read => 2, Write => 4, Input => 0, Output => 0) then`
316			`Failed ("Error writing discriminants - 4");`
317			`end if;`
318			`if Parent_Ops.Get_Counts /=`
319			`(Read => 3, Write => 4, Input => 1, Output => 2) then`
320			`Failed ("Didn't call inherited Output - 4");`
321			`end if;`
322
323			`declare`
324			`Y2 : Derived2 := Derived2'Input (S'Access);`
325			`begin`
326			`if Int_Ops.Get_Counts /=`
327			`(Read => 4, Write => 4, Input => 0, Output => 0) then`
328			`Failed ("Error reading discriminants - 4");`
329			`end if;`
330			`if Parent_Ops.Get_Counts /=`
331			`(Read => 4, Write => 4, Input => 2, Output => 2) then`
332			`Failed ("Didn't call inherited Input - 4");`
333			`end if;`
334
335			`if Y2 /= (D => 8,`
336			`S => Str (Ident_Str ("8")),`
337			`C1 => Ident_Int (7)) then`
338			`Failed`
339			`("Inherited Input and Output are not inverses of each other - 4");`
340			`end if;`
341			`end;`
342			`end Test2;`
343
344			`Result;`
345			`end CDD2A02;`