gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cd/cdd2001.a

   1 -- CDD2001.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 default implementation of Read and Input raise End_Error
  28 --    if the end of stream is reached before the reading of a value is
  29 --    completed.  (Defect Report 8652/0045,
  30 --    Technical Corrigendum 13.13.2(35.1/1)).
  31 --
  32 -- CHANGE HISTORY:
  33 --    12 FEB 2001   PHL   Initial version.
  34 --    29 JUN 2001   RLB   Reformatted for ACATS.
  35 --
  36 --!
  37
  38 with Ada.Streams;
  39 use Ada.Streams;
  40 package CDD2001_0 is
  41
  42     type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
  43         record
  44             First : Stream_Element_Offset := 1;
  45             Last : Stream_Element_Offset := 0;
  46             Contents : Stream_Element_Array (1 .. Size);
  47         end record;
  48
  49     procedure Clear (Stream : in out My_Stream);
  50
  51     procedure Read (Stream : in out My_Stream;
  52                     Item : out Stream_Element_Array;
  53                     Last : out Stream_Element_Offset);
  54
  55     procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
  56
  57 end CDD2001_0;
  58
  59 package body CDD2001_0 is
  60
  61     procedure Clear (Stream : in out My_Stream) is
  62     begin
  63         Stream.First := 1;
  64         Stream.Last := 0;
  65     end Clear;
  66
  67     procedure Read (Stream : in out My_Stream;
  68                     Item : out Stream_Element_Array;
  69                     Last : out Stream_Element_Offset) is
  70     begin
  71         if Item'Length >= Stream.Last - Stream.First + 1 then
  72             Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
  73                Stream.Contents (Stream.First .. Stream.Last);
  74             Last := Item'First + Stream.Last - Stream.First;
  75             Stream.First := Stream.Last + 1;
  76         else
  77             Item := Stream.Contents (Stream.First ..
  78                                         Stream.First + Item'Length - 1);
  79             Last := Item'Last;
  80             Stream.First := Stream.First + Item'Length;
  81         end if;
  82     end Read;
  83
  84     procedure Write (Stream : in out My_Stream;
  85                      Item : in Stream_Element_Array) is
  86     begin
  87         Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
  88         Stream.Last := Stream.Last + Item'Length;
  89     end Write;
  90
  91 end CDD2001_0;
  92
  93 with Ada.Exceptions;
  94 use Ada.Exceptions;
  95 with CDD2001_0;
  96 use CDD2001_0;
  97 with Io_Exceptions;
  98 use Io_Exceptions;
  99 with Report;
 100 use Report;
 101 procedure CDD2001 is
 102
 103     subtype Int is Integer range -20 .. 20;
 104
 105     type R (D : Int) is
 106         record
 107             C1 : Character := Ident_Char ('a');
 108             case D is
 109                 when 0 .. 20 =>
 110                     C2 : String (1 .. D) := (others => Ident_Char ('b'));
 111                 when others =>
 112                     C3, C4 : Float := Float (-D);
 113             end case;
 114         end record;
 115
 116     S : aliased My_Stream (200);
 117
 118 begin
 119     Test
 120        ("CDD2001",
 121            "Check that the default implementation of Read and Input " &
 122            "raise End_Error if the end of stream is reached before the " &
 123            "reading of a value is completed");
 124
 125     Read:
 126         declare
 127             X : R (Ident_Int (13));
 128         begin
 129             Clear (S);
 130
 131             -- A complete object.
 132             R'Write (S'Access, X);
 133             X.C1 := Ident_Char ('A');
 134             X.C2 := (others => Ident_Char ('B'));
 135             R'Read (S'Access, X);
 136             if X.C1 /= Ident_Char ('a') or X.C2 /=
 137                                               (1 .. 13 => Ident_Char ('b')) then
 138                 Failed ("Read did not produce the expected result");
 139             end if;
 140
 141             Clear (S);
 142
 143             -- Not enough data.
 144             Character'Write (S'Access, 'a');
 145             String'Write (S'Access, "bbb");
 146
 147             begin
 148                 R'Read (S'Access, X);
 149                 Failed
 150                    ("No exception raised when the end of stream is reached " &
 151                     "before the reading of a value is completed - 1");
 152             exception
 153                 when End_Error =>
 154                     null;
 155                 when E: others =>
 156                     Failed ("Wrong Exception " & Exception_Name (E) &
 157                             " - " & Exception_Information (E) &
 158                             " - " & Exception_Message (E) & " - 1");
 159             end;
 160
 161         end Read;
 162
 163     Input:
 164         declare
 165             X : R (Ident_Int (-11));
 166         begin
 167             Clear (S);
 168
 169             -- A complete object.
 170             R'Output (S'Access, X);
 171             X.C1 := Ident_Char ('A');
 172             X.C3 := 4.0;
 173             X.C4 := 5.0;
 174             X := R'Input (S'Access);
 175             if X.C1 /= Ident_Char ('a') or X.C3 /= 11.0 or X.C4 /= 11.0 then
 176                 Failed ("Input did not produce the expected result");
 177             end if;
 178
 179             Clear (S);
 180
 181             -- Not enough data.
 182             Integer'Output (S'Access, Ident_Int (-11)); -- The discriminant
 183             Character'Output (S'Access, 'a');
 184             Float'Output (S'Access, 11.0);
 185
 186             begin
 187                 X := R'Input (S'Access);
 188                 Failed
 189                    ("No exception raised when the end of stream is reached " &
 190                     "before the reading of a value is completed - 2");
 191             exception
 192                 when End_Error =>
 193                     null;
 194                 when E: others =>
 195                     Failed ("Wrong exception " & Exception_Name (E) &
 196                             " - " & Exception_Message (E) & " - 2");
 197             end;
 198
 199         end Input;
 200
 201     Result;
 202 end CDD2001;
 203