cd10002.a

xml大全 可读写调用率很高 xml大全 可读写调用率很高

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