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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


-- CDD2A01.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 and Write attributes for a type extension are created
--    from the parent type's attribute (which may be user-defined) and those
--    for the extension components.  Also check that the default Input and
--    Output attributes are used for a type extension, even if the parent
--    type's attribute is user-defined.  (Defect Report 8652/0040,
--     as reflected in Technical Corrigendum 1, penultimate sentence of
--     13.13.2(9/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 CDD2A01 is
 
    Input_Output_Error : exception;
 
    type Int is range 1 .. 1000;
    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 tagged
        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
        X : Parent (1, 1, True);
    begin
        raise Input_Output_Error;
        return X;
    end Actual_Input;
 
    procedure Actual_Output
                 (Stream : access Root_Stream_Type'Class; Item : Parent) is
    begin
        raise Input_Output_Error;
    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;
 
    type Derived1 is new Parent with
        record
            C3 : Int;
        end record;
 
    type Derived2 (D : Int) is new Parent (D1 => D,
                                           D2 => D,
                                           B => False) with
        record
            C3 : Int;
        end record;
 
begin
    Test ("CDD2A01",
          "Check that the Read and Write attributes for a type " &
             "extension are created from the parent type's " &
             "attribute (which may be user-defined) and those for the " &
             "extension components; also check that the default input " &
             "and output attributes are used for a type extension, even " &
             "if the parent type's attribute is user-defined");
 
    Test1:
        declare
            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),
                              C3 => Int (Ident_Int (88)));
            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));
            X1.C3 := Int (Ident_Int (99));
 
            Derived1'Write (S'Access, X1);
            if Int_Ops.Get_Counts /=
               (Read => 0, Write => 1, Input => 0, Output => 0) then
                Failed ("Error writing extension components - 1");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 0, Write => 1, Input => 0, Output => 0) then
                Failed ("Didn't call parent type's Write - 1");
            end if;
 
            Derived1'Read (S'Access, X2);
            if Int_Ops.Get_Counts /=
               (Read => 1, Write => 1, Input => 0, Output => 0) then
                Failed ("Error reading extension components - 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)),
                      C3 => Int (Ident_Int (99))) then
                Failed
                   ("Inherited Read and Write are not inverses of each other - 1");
            end if;
 
            begin
                Derived1'Output (S'Access, Y1);
                if Int_Ops.Get_Counts /=
                   (Read => 1, Write => 4, Input => 0, Output => 0) then
                    Failed ("Error writing extension components - 2");
                end if;
                if Parent_Ops.Get_Counts /=
                   (Read => 1, Write => 2, Input => 0, Output => 0) then
                    Failed ("Didn't call inherited Write - 2");
                end if;
            exception
                when Input_Output_Error =>
                    Failed ("Did call inherited Output - 2");
            end;
 
            begin
                declare
                    Y2 : Derived1 := Derived1'Input (S'Access);
                begin
                    if Int_Ops.Get_Counts /=
                       (Read => 4, Write => 4, Input => 0, Output => 0) then
                        Failed ("Error reading extension components - 2");
                    end if;
                    if Parent_Ops.Get_Counts /=
                       (Read => 2, Write => 2, Input => 0, Output => 0) then
                        Failed ("Didn't call inherited Read - 2");
                    end if;
                    if Y2 /= (D1 => 3,
                              D2 => 6,
                              B => False,
                              S => Str (Ident_Str ("3456")),
                              C1 => Ident_Int (7),
                              C3 => Int (Ident_Int (88))) then
                        Failed
                           ("Input and Output are not inverses of each other - 2");
                    end if;
                end;
            exception
                when Input_Output_Error =>
                    Failed ("Did call inherited Input - 2");
            end;
 
        end Test1;
 
    Test2:
        declare
            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),
                              C3 => Int (Ident_Int (77)));
            X2 : Derived2 (D => Int (Ident_Int (7)));
        begin
            X1.S := Str (Ident_Str ("g"));
            X1.C1 := Ident_Int (4);
            X1.C3 := Int (Ident_Int (666));
 
            Derived2'Write (S'Access, X1);
            if Int_Ops.Get_Counts /=
               (Read => 4, Write => 5, Input => 0, Output => 0) then
                Failed ("Error writing extension components - 3");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 2, Write => 3, Input => 0, Output => 0) then
                Failed ("Didn't call inherited Write - 3");
            end if;
 
            Derived2'Read (S'Access, X2);
            if Int_Ops.Get_Counts /=
               (Read => 5, Write => 5, Input => 0, Output => 0) then
                Failed ("Error reading extension components - 3");
            end if;
            if Parent_Ops.Get_Counts /=
               (Read => 3, Write => 3, Input => 0, Output => 0) then
                Failed ("Didn't call inherited Read - 3");
            end if;
 
            if X2 /= (D => 7,
                      S => Str (Ident_Str ("g")),
                      C1 => Ident_Int (7),
                      C3 => Int (Ident_Int (666))) then
                Failed ("Read and Write are not inverses of each other - 3");
            end if;
 
            begin
                Derived2'Output (S'Access, Y1);
                if Int_Ops.Get_Counts /=
                   (Read => 5, Write => 7, Input => 0, Output => 0) then
                    Failed ("Error writing extension components - 4");
                end if;
                if Parent_Ops.Get_Counts /=
                   (Read => 3, Write => 4, Input => 0, Output => 0) then
                    Failed ("Didn't call inherited Write - 4");
                end if;
            exception
                when Input_Output_Error =>
                    Failed ("Did call inherited Output - 4");
            end;
 
            begin
                declare
                    Y2 : Derived2 := Derived2'Input (S'Access);
                begin
                    if Int_Ops.Get_Counts /=
                       (Read => 7, Write => 7, Input => 0, Output => 0) then
                        Failed ("Error reading extension components - 4");
                    end if;
                    if Parent_Ops.Get_Counts /=
                       (Read => 4, Write => 4, Input => 0, Output => 0) then
                        Failed ("Didn't call inherited Read - 4");
                    end if;
                    if Y2 /= (D => 8,
                              S => Str (Ident_Str ("8")),
                              C1 => Ident_Int (7),
                              C3 => Int (Ident_Int (77))) then
                        Failed
                           ("Input and Output are not inverses of each other - 4");
                    end if;
                end;
            exception
                when Input_Output_Error =>
                    Failed ("Did call inherited Input - 4");
            end;
 
        end Test2;
 
    Result;
end CDD2A01;

Browse

Tools

Subversion Repositories openrisc

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

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- CDD2A01.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 and Write attributes for a type extension are created`
28			`-- from the parent type's attribute (which may be user-defined) and those`
29			`-- for the extension components. Also check that the default Input and`
30			`-- Output attributes are used for a type extension, even if the parent`
31			`-- type's attribute is user-defined. (Defect Report 8652/0040,`
32			`-- as reflected in Technical Corrigendum 1, penultimate sentence of`
33			`-- 13.13.2(9/1) and 13.13.2(25/1)).`
34			`--`
35			`-- CHANGE HISTORY:`
36			`-- 30 JUL 2001 PHL Initial version.`
37			`-- 5 DEC 2001 RLB Reformatted for ACATS.`
38			`--`
39			`--!`
40			`with Ada.Streams;`
41			`use Ada.Streams;`
42			`with FDD2A00;`
43			`use FDD2A00;`
44			`with Report;`
45			`use Report;`
46			`procedure CDD2A01 is`
47
48			`Input_Output_Error : exception;`
49
50			`type Int is range 1 .. 1000;`
51			`type Str is array (Int range <>) of Character;`
52
53			`procedure Read (Stream : access Root_Stream_Type'Class;`
54			`Item : out Int'Base);`
55			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base);`
56			`function Input (Stream : access Root_Stream_Type'Class) return Int'Base;`
57			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base);`
58
59			`for Int'Read use Read;`
60			`for Int'Write use Write;`
61			`for Int'Input use Input;`
62			`for Int'Output use Output;`
63
64
65			`type Parent (D1, D2 : Int; B : Boolean) is tagged`
66			`record`
67			`S : Str (D1 .. D2);`
68			`case B is`
69			`when False =>`
70			`C1 : Integer;`
71			`when True =>`
72			`C2 : Float;`
73			`end case;`
74			`end record;`
75
76			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent);`
77			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent);`
78			`function Input (Stream : access Root_Stream_Type'Class) return Parent;`
79			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent);`
80
81			`for Parent'Read use Read;`
82			`for Parent'Write use Write;`
83			`for Parent'Input use Input;`
84			`for Parent'Output use Output;`
85
86
87			`procedure Actual_Read`
88			`(Stream : access Root_Stream_Type'Class; Item : out Int) is`
89			`begin`
90			`Integer'Read (Stream, Integer (Item));`
91			`end Actual_Read;`
92
93			`procedure Actual_Write`
94			`(Stream : access Root_Stream_Type'Class; Item : Int) is`
95			`begin`
96			`Integer'Write (Stream, Integer (Item));`
97			`end Actual_Write;`
98
99			`function Actual_Input (Stream : access Root_Stream_Type'Class) return Int is`
100			`begin`
101			`return Int (Integer'Input (Stream));`
102			`end Actual_Input;`
103
104			`procedure Actual_Output`
105			`(Stream : access Root_Stream_Type'Class; Item : Int) is`
106			`begin`
107			`Integer'Output (Stream, Integer (Item));`
108			`end Actual_Output;`
109
110
111			`procedure Actual_Read`
112			`(Stream : access Root_Stream_Type'Class; Item : out Parent) is`
113			`begin`
114			`case Item.B is`
115			`when False =>`
116			`Item.C1 := 7;`
117			`when True =>`
118			`Float'Read (Stream, Item.C2);`
119			`end case;`
120			`Str'Read (Stream, Item.S);`
121			`end Actual_Read;`
122
123			`procedure Actual_Write`
124			`(Stream : access Root_Stream_Type'Class; Item : Parent) is`
125			`begin`
126			`case Item.B is`
127			`when False =>`
128			`null; -- Don't write C1`
129			`when True =>`
130			`Float'Write (Stream, Item.C2);`
131			`end case;`
132			`Str'Write (Stream, Item.S);`
133			`end Actual_Write;`
134
135			`function Actual_Input`
136			`(Stream : access Root_Stream_Type'Class) return Parent is`
137			`X : Parent (1, 1, True);`
138			`begin`
139			`raise Input_Output_Error;`
140			`return X;`
141			`end Actual_Input;`
142
143			`procedure Actual_Output`
144			`(Stream : access Root_Stream_Type'Class; Item : Parent) is`
145			`begin`
146			`raise Input_Output_Error;`
147			`end Actual_Output;`
148
149			`package Int_Ops is new Counting_Stream_Ops (T => Int'Base,`
150			`Actual_Write => Actual_Write,`
151			`Actual_Input => Actual_Input,`
152			`Actual_Read => Actual_Read,`
153			`Actual_Output => Actual_Output);`
154
155			`package Parent_Ops is`
156			`new Counting_Stream_Ops (T => Parent,`
157			`Actual_Write => Actual_Write,`
158			`Actual_Input => Actual_Input,`
159			`Actual_Read => Actual_Read,`
160			`Actual_Output => Actual_Output);`
161
162			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Int'Base)`
163			`renames Int_Ops.Read;`
164			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Int'Base)`
165			`renames Int_Ops.Write;`
166			`function Input (Stream : access Root_Stream_Type'Class) return Int'Base`
167			`renames Int_Ops.Input;`
168			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Int'Base)`
169			`renames Int_Ops.Output;`
170
171			`procedure Read (Stream : access Root_Stream_Type'Class; Item : out Parent)`
172			`renames Parent_Ops.Read;`
173			`procedure Write (Stream : access Root_Stream_Type'Class; Item : Parent)`
174			`renames Parent_Ops.Write;`
175			`function Input (Stream : access Root_Stream_Type'Class) return Parent`
176			`renames Parent_Ops.Input;`
177			`procedure Output (Stream : access Root_Stream_Type'Class; Item : Parent)`
178			`renames Parent_Ops.Output;`
179
180			`type Derived1 is new Parent with`
181			`record`
182			`C3 : Int;`
183			`end record;`
184
185			`type Derived2 (D : Int) is new Parent (D1 => D,`
186			`D2 => D,`
187			`B => False) with`
188			`record`
189			`C3 : Int;`
190			`end record;`
191
192			`begin`
193			`Test ("CDD2A01",`
194			`"Check that the Read and Write attributes for a type " &`
195			`"extension are created from the parent type's " &`
196			`"attribute (which may be user-defined) and those for the " &`
197			`"extension components; also check that the default input " &`
198			`"and output attributes are used for a type extension, even " &`
199			`"if the parent type's attribute is user-defined");`
200
201			`Test1:`
202			`declare`
203			`S : aliased My_Stream (1000);`
204			`X1 : Derived1 (D1 => Int (Ident_Int (2)),`
205			`D2 => Int (Ident_Int (5)),`
206			`B => Ident_Bool (True));`
207			`Y1 : Derived1 := (D1 => 3,`
208			`D2 => 6,`
209			`B => False,`
210			`S => Str (Ident_Str ("3456")),`
211			`C1 => Ident_Int (100),`
212			`C3 => Int (Ident_Int (88)));`
213			`X2 : Derived1 (D1 => Int (Ident_Int (2)),`
214			`D2 => Int (Ident_Int (5)),`
215			`B => Ident_Bool (True));`
216			`begin`
217			`X1.S := Str (Ident_Str ("bcde"));`
218			`X1.C2 := Float (Ident_Int (4));`
219			`X1.C3 := Int (Ident_Int (99));`
220
221			`Derived1'Write (S'Access, X1);`
222			`if Int_Ops.Get_Counts /=`
223			`(Read => 0, Write => 1, Input => 0, Output => 0) then`
224			`Failed ("Error writing extension components - 1");`
225			`end if;`
226			`if Parent_Ops.Get_Counts /=`
227			`(Read => 0, Write => 1, Input => 0, Output => 0) then`
228			`Failed ("Didn't call parent type's Write - 1");`
229			`end if;`
230
231			`Derived1'Read (S'Access, X2);`
232			`if Int_Ops.Get_Counts /=`
233			`(Read => 1, Write => 1, Input => 0, Output => 0) then`
234			`Failed ("Error reading extension components - 1");`
235			`end if;`
236			`if Parent_Ops.Get_Counts /=`
237			`(Read => 1, Write => 1, Input => 0, Output => 0) then`
238			`Failed ("Didn't call inherited Read - 1");`
239			`end if;`
240
241			`if X2 /= (D1 => 2,`
242			`D2 => 5,`
243			`B => True,`
244			`S => Str (Ident_Str ("bcde")),`
245			`C2 => Float (Ident_Int (4)),`
246			`C3 => Int (Ident_Int (99))) then`
247			`Failed`
248			`("Inherited Read and Write are not inverses of each other - 1");`
249			`end if;`
250
251			`begin`
252			`Derived1'Output (S'Access, Y1);`
253			`if Int_Ops.Get_Counts /=`
254			`(Read => 1, Write => 4, Input => 0, Output => 0) then`
255			`Failed ("Error writing extension components - 2");`
256			`end if;`
257			`if Parent_Ops.Get_Counts /=`
258			`(Read => 1, Write => 2, Input => 0, Output => 0) then`
259			`Failed ("Didn't call inherited Write - 2");`
260			`end if;`
261			`exception`
262			`when Input_Output_Error =>`
263			`Failed ("Did call inherited Output - 2");`
264			`end;`
265
266			`begin`
267			`declare`
268			`Y2 : Derived1 := Derived1'Input (S'Access);`
269			`begin`
270			`if Int_Ops.Get_Counts /=`
271			`(Read => 4, Write => 4, Input => 0, Output => 0) then`
272			`Failed ("Error reading extension components - 2");`
273			`end if;`
274			`if Parent_Ops.Get_Counts /=`
275			`(Read => 2, Write => 2, Input => 0, Output => 0) then`
276			`Failed ("Didn't call inherited Read - 2");`
277			`end if;`
278			`if Y2 /= (D1 => 3,`
279			`D2 => 6,`
280			`B => False,`
281			`S => Str (Ident_Str ("3456")),`
282			`C1 => Ident_Int (7),`
283			`C3 => Int (Ident_Int (88))) then`
284			`Failed`
285			`("Input and Output are not inverses of each other - 2");`
286			`end if;`
287			`end;`
288			`exception`
289			`when Input_Output_Error =>`
290			`Failed ("Did call inherited Input - 2");`
291			`end;`
292
293			`end Test1;`
294
295			`Test2:`
296			`declare`
297			`S : aliased My_Stream (1000);`
298			`X1 : Derived2 (D => Int (Ident_Int (7)));`
299			`Y1 : Derived2 := (D => 8,`
300			`S => Str (Ident_Str ("8")),`
301			`C1 => Ident_Int (200),`
302			`C3 => Int (Ident_Int (77)));`
303			`X2 : Derived2 (D => Int (Ident_Int (7)));`
304			`begin`
305			`X1.S := Str (Ident_Str ("g"));`
306			`X1.C1 := Ident_Int (4);`
307			`X1.C3 := Int (Ident_Int (666));`
308
309			`Derived2'Write (S'Access, X1);`
310			`if Int_Ops.Get_Counts /=`
311			`(Read => 4, Write => 5, Input => 0, Output => 0) then`
312			`Failed ("Error writing extension components - 3");`
313			`end if;`
314			`if Parent_Ops.Get_Counts /=`
315			`(Read => 2, Write => 3, Input => 0, Output => 0) then`
316			`Failed ("Didn't call inherited Write - 3");`
317			`end if;`
318
319			`Derived2'Read (S'Access, X2);`
320			`if Int_Ops.Get_Counts /=`
321			`(Read => 5, Write => 5, Input => 0, Output => 0) then`
322			`Failed ("Error reading extension components - 3");`
323			`end if;`
324			`if Parent_Ops.Get_Counts /=`
325			`(Read => 3, Write => 3, Input => 0, Output => 0) then`
326			`Failed ("Didn't call inherited Read - 3");`
327			`end if;`
328
329			`if X2 /= (D => 7,`
330			`S => Str (Ident_Str ("g")),`
331			`C1 => Ident_Int (7),`
332			`C3 => Int (Ident_Int (666))) then`
333			`Failed ("Read and Write are not inverses of each other - 3");`
334			`end if;`
335
336			`begin`
337			`Derived2'Output (S'Access, Y1);`
338			`if Int_Ops.Get_Counts /=`
339			`(Read => 5, Write => 7, Input => 0, Output => 0) then`
340			`Failed ("Error writing extension components - 4");`
341			`end if;`
342			`if Parent_Ops.Get_Counts /=`
343			`(Read => 3, Write => 4, Input => 0, Output => 0) then`
344			`Failed ("Didn't call inherited Write - 4");`
345			`end if;`
346			`exception`
347			`when Input_Output_Error =>`
348			`Failed ("Did call inherited Output - 4");`
349			`end;`
350
351			`begin`
352			`declare`
353			`Y2 : Derived2 := Derived2'Input (S'Access);`
354			`begin`
355			`if Int_Ops.Get_Counts /=`
356			`(Read => 7, Write => 7, Input => 0, Output => 0) then`
357			`Failed ("Error reading extension components - 4");`
358			`end if;`
359			`if Parent_Ops.Get_Counts /=`
360			`(Read => 4, Write => 4, Input => 0, Output => 0) then`
361			`Failed ("Didn't call inherited Read - 4");`
362			`end if;`
363			`if Y2 /= (D => 8,`
364			`S => Str (Ident_Str ("8")),`
365			`C1 => Ident_Int (7),`
366			`C3 => Int (Ident_Int (77))) then`
367			`Failed`
368			`("Input and Output are not inverses of each other - 4");`
369			`end if;`
370			`end;`
371			`exception`
372			`when Input_Output_Error =>`
373			`Failed ("Did call inherited Input - 4");`
374			`end;`
375
376			`end Test2;`
377
378			`Result;`
379			`end CDD2A01;`