Subversion Repositories openrisc_me

-- CDD2001.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 default implementation of Read and Input raise End_Error

--    if the end of stream is reached before the reading of a value is

--    completed.  (Defect Report 8652/0045,

--    Technical Corrigendum 13.13.2(35.1/1)).

--

-- CHANGE HISTORY:

--    12 FEB 2001   PHL   Initial version.

--    29 JUN 2001   RLB   Reformatted for ACATS.

--

--!

with Ada.Streams;

use Ada.Streams;

package CDD2001_0 is

    type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with

        record

            First : Stream_Element_Offset := 1;

            Last : Stream_Element_Offset := 0;

            Contents : Stream_Element_Array (1 .. Size);

        end record;

    procedure Clear (Stream : in out My_Stream);

    procedure Read (Stream : in out My_Stream;

                    Item : out Stream_Element_Array;

                    Last : out Stream_Element_Offset);

    procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);

end CDD2001_0;

package body CDD2001_0 is

    procedure Clear (Stream : in out My_Stream) is

    begin

        Stream.First := 1;

        Stream.Last := 0;

    end Clear;

    procedure Read (Stream : in out My_Stream;

                    Item : out Stream_Element_Array;

                    Last : out Stream_Element_Offset) is

    begin

        if Item'Length >= Stream.Last - Stream.First + 1 then

            Item (Item'First .. Item'First + Stream.Last - Stream.First) :=

               Stream.Contents (Stream.First .. Stream.Last);

            Last := Item'First + Stream.Last - Stream.First;

            Stream.First := Stream.Last + 1;

        else

            Item := Stream.Contents (Stream.First ..

                                        Stream.First + Item'Length - 1);

            Last := Item'Last;

            Stream.First := Stream.First + Item'Length;

        end if;

    end Read;

    procedure Write (Stream : in out My_Stream;

                     Item : in Stream_Element_Array) is

    begin

        Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;

        Stream.Last := Stream.Last + Item'Length;

    end Write;

end CDD2001_0;

with Ada.Exceptions;

use Ada.Exceptions;

with CDD2001_0;

use CDD2001_0;

with Io_Exceptions;

use Io_Exceptions;

with Report;

use Report;

procedure CDD2001 is

    subtype Int is Integer range -20 .. 20;

    type R (D : Int) is

        record

            C1 : Character := Ident_Char ('a');

            case D is

                when 0 .. 20 =>

                    C2 : String (1 .. D) := (others => Ident_Char ('b'));

                when others =>

                    C3, C4 : Float := Float (-D);

            end case;

        end record;

    S : aliased My_Stream (200);

begin

    Test

       ("CDD2001",

           "Check that the default implementation of Read and Input " &

           "raise End_Error if the end of stream is reached before the " &

           "reading of a value is completed");

    Read:

        declare

            X : R (Ident_Int (13));

        begin

            Clear (S);

            -- A complete object.

            R'Write (S'Access, X);

            X.C1 := Ident_Char ('A');

            X.C2 := (others => Ident_Char ('B'));

            R'Read (S'Access, X);

            if X.C1 /= Ident_Char ('a') or X.C2 /=

                                              (1 .. 13 => Ident_Char ('b')) then

                Failed ("Read did not produce the expected result");

            end if;

            Clear (S);

            -- Not enough data.

            Character'Write (S'Access, 'a');

            String'Write (S'Access, "bbb");

            begin

                R'Read (S'Access, X);

                Failed

                   ("No exception raised when the end of stream is reached " &

                    "before the reading of a value is completed - 1");

            exception

                when End_Error =>

                    null;

                when E: others =>

                    Failed ("Wrong Exception " & Exception_Name (E) &

                            " - " & Exception_Information (E) &

                            " - " & Exception_Message (E) & " - 1");

            end;

        end Read;

    Input:

        declare

            X : R (Ident_Int (-11));

        begin

            Clear (S);

            -- A complete object.

            R'Output (S'Access, X);

            X.C1 := Ident_Char ('A');

            X.C3 := 4.0;

            X.C4 := 5.0;

            X := R'Input (S'Access);

            if X.C1 /= Ident_Char ('a') or X.C3 /= 11.0 or X.C4 /= 11.0 then

                Failed ("Input did not produce the expected result");

            end if;

            Clear (S);

            -- Not enough data.

            Integer'Output (S'Access, Ident_Int (-11)); -- The discriminant

            Character'Output (S'Access, 'a');

            Float'Output (S'Access, 11.0);

            begin

                X := R'Input (S'Access);

                Failed

                   ("No exception raised when the end of stream is reached " &

                    "before the reading of a value is completed - 2");

            exception

                when End_Error =>

                    null;

                when E: others =>

                    Failed ("Wrong exception " & Exception_Name (E) &

                            " - " & Exception_Message (E) & " - 2");

            end;

        end Input;

    Result;

end CDD2001;