diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cd/cdd2001.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cd/cdd2001.a | 203 |
1 files changed, 0 insertions, 203 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cd/cdd2001.a b/gcc/testsuite/ada/acats/tests/cd/cdd2001.a deleted file mode 100644 index 3184dded8d4..00000000000 --- a/gcc/testsuite/ada/acats/tests/cd/cdd2001.a +++ /dev/null @@ -1,203 +0,0 @@ --- 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; - |