--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cd/cdd2001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,203 @@
+-- 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;
+