--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cc/cc51001.a	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,186 @@
+-- CC51001.A
+--
+--                             Grant of Unlimited Rights
+--
+--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
+--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
+--     unlimited rights in the software and documentation contained herein.
+--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
+--     this public release, the Government intends to confer upon all 
+--     recipients unlimited rights  equal to those held by the Government.  
+--     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 a formal parameter of a generic package may be a formal
+--      derived type. Check that the formal derived type may have an unknown
+--      discriminant part. Check that the ancestor type in a formal derived
+--      type definition may be a tagged type, and that the actual parameter
+--      may be a descendant of the ancestor type. Check that the formal derived
+--      type belongs to the derivation class rooted at the ancestor type;
+--      specifically, that components of the ancestor type may be referenced
+--      within the generic. Check that if a formal derived subtype is
+--      indefinite then the actual may be either definite or indefinite.
+--
+-- TEST DESCRIPTION:
+--      Define a class of tagged types with a definite root type. Extend the
+--      root type with a discriminated component. Since discriminants of
+--      tagged types may not have defaults, the type is indefinite.
+--
+--      Extend the extension with a second discriminated component, but with
+--      a new discriminant part. Declare a generic package with a formal
+--      derived type using the root type of the class as ancestor, and an
+--      unknown discriminant part. Declare an operation in the generic which
+--      accesses the common component of types in the class.
+--
+--      In the main program, instantiate the generic with each type in the
+--      class and verify that the operation correctly accesses the common
+--      component.
+--
+--
+-- CHANGE HISTORY:
+--      06 Dec 94   SAIC    ACVC 2.0
+--
+--!
+
+package CC51001_0 is  -- Root type for message class.
+
+   subtype Msg_String is String (1 .. 20);
+
+   type Msg_Type is tagged record                          -- Root type of
+      Text : Msg_String := (others => ' ');                -- class (definite).
+   end record;
+
+end CC51001_0;
+
+
+-- No body for CC51001_0.
+
+
+     --==================================================================--
+
+
+with CC51001_0;       -- Root type for message class.
+package CC51001_1 is  -- Extensions to message class.
+
+   subtype Source_Length is Natural range 0 .. 10;
+
+   type From_Msg_Type (SLen : Source_Length) is            -- Direct derivative
+     new CC51001_0.Msg_Type with record                    -- of root type
+      From : String (1 .. SLen);                           -- (indefinite).
+   end record;
+
+   subtype Dest_Length is Natural range 0 .. 10;
+
+
+
+   type To_From_Msg_Type (DLen : Dest_Length) is           -- Indirect
+     new From_Msg_Type (SLen => 10) with record            -- derivative of
+      To : String (1 .. DLen);                             -- root type
+   end record;                                             -- (indefinite).
+
+end CC51001_1;
+
+
+-- No body for CC51001_1.
+
+
+     --==================================================================--
+
+
+with CC51001_0;       -- Root type for message class.
+generic               -- I/O operations for message class.
+   type Message_Type (<>) is new CC51001_0.Msg_Type with private;
+package CC51001_2 is
+
+   -- This subprogram contains an artificial result for testing purposes:
+   -- the function returns the text of the message to the caller as a string.
+
+   function Print_Message (M : in Message_Type) return String;
+
+   -- ... Other operations.
+
+end CC51001_2;
+
+
+     --==================================================================--
+
+
+package body CC51001_2 is
+
+   -- The implementations of the operations below are purely artificial; the
+   -- validity of their implementations in the context of the abstraction is
+   -- irrelevant to the feature being tested.
+
+   function Print_Message (M : in Message_Type) return String is
+   begin
+      return M.Text;
+   end Print_Message;
+
+end CC51001_2;
+
+
+     --==================================================================--
+
+
+with CC51001_0;  -- Root type for message class.
+with CC51001_1;  -- Extensions to message class.
+with CC51001_2;  -- I/O operations for message class.
+
+with Report;
+procedure CC51001 is
+
+   -- Instantiate for various types in the class:
+
+   package Msgs   is new CC51001_2 (CC51001_0.Msg_Type);         -- Definite.
+   package FMsgs  is new CC51001_2 (CC51001_1.From_Msg_Type);    -- Indefinite.
+   package TFMsgs is new CC51001_2 (CC51001_1.To_From_Msg_Type); -- Indefinite.
+
+
+
+   Msg   : CC51001_0.Msg_Type         := (Text => "This is message #001");
+   FMsg  : CC51001_1.From_Msg_Type    := (Text => "This is message #002",
+                                          SLen => 2,
+                                          From => "Me");
+   TFMsg : CC51001_1.To_From_Msg_Type := (Text => "This is message #003",
+                                          From => "You       ",
+                                          DLen => 4,
+                                          To   => "Them");
+
+   Expected_Msg   : constant String := "This is message #001";
+   Expected_FMsg  : constant String := "This is message #002";
+   Expected_TFMsg : constant String := "This is message #003";
+
+begin
+   Report.Test ("CC51001", "Check that the formal derived type may have " &
+                "an unknown discriminant part. Check that the ancestor " &
+                "type in a formal derived type definition may be a " &
+                "tagged type, and that the actual parameter may be any " &
+                "definite or indefinite descendant of the ancestor type");
+
+   if (Msgs.Print_Message (Msg) /= Expected_Msg) then
+      Report.Failed ("Wrong result for definite root type");
+   end if;
+
+   if (FMsgs.Print_Message (FMsg) /= Expected_FMsg) then
+      Report.Failed ("Wrong result for direct indefinite derivative");
+   end if;
+
+   if (TFMsgs.Print_Message (TFMsg) /= Expected_TFMsg) then
+      Report.Failed ("Wrong result for Indirect indefinite derivative");
+   end if;
+
+   Report.Result;
+end CC51001;