--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/cc/cc3601a.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,251 @@
+-- CC3601A.ADA
+
+--                             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.
+--*
+-- CHECK THAT PREDEFINED OPERATORS MAY BE PASSED AS ACTUAL
+-- GENERIC SUBPROGRAM PARAMETERS (CHECKS FOR "=" AND "/=" ARE IN
+-- CC3601C).
+
+-- R.WILLIAMS 10/9/86
+-- JRL        11/15/95 Added unknown discriminant part to all formal
+--                     private types.
+
+
+WITH REPORT; USE REPORT;
+PROCEDURE CC3601A IS
+
+     GENERIC
+          TYPE T (<>) IS PRIVATE;
+          V, V1 : T;
+          KIND : STRING;
+          WITH FUNCTION F1 (X : IN T) RETURN T;
+     PACKAGE GP1 IS
+          R : BOOLEAN := F1 (V) = V1;
+     END GP1;
+
+     PACKAGE BODY GP1 IS
+     BEGIN
+          IF NOT (IDENT_BOOL(R)) THEN
+               FAILED ( "INCORRECT VALUE FOR UNARY OP - " & KIND);
+          END IF;
+     END GP1;
+
+     GENERIC
+          TYPE T (<>) IS PRIVATE;
+          V, V1, V2 : IN T;
+          KIND : STRING;
+          WITH FUNCTION F1 (P1 : IN T; P2 : IN T) RETURN T;
+     PACKAGE GP2 IS
+          R : BOOLEAN := V /= F1 (V1, V2);
+     END GP2;
+
+     PACKAGE BODY GP2 IS
+     BEGIN
+          IF IDENT_BOOL (R) THEN
+               FAILED ( "INCORRECT VALUE FOR BINARY OP - " & KIND);
+          END IF;
+     END GP2;
+
+     
+     GENERIC
+          TYPE T1 (<>) IS PRIVATE;
+          TYPE T2 (<>) IS PRIVATE;
+          V1 : T1;
+          V2 : T2;
+          KIND : STRING;
+          WITH FUNCTION F1 (X : IN T1) RETURN T2;
+     PACKAGE GP3 IS
+          R : BOOLEAN := F1 (V1) = V2;
+     END GP3;
+
+     PACKAGE BODY GP3 IS
+     BEGIN
+          IF NOT (IDENT_BOOL(R)) THEN
+               FAILED ( "INCORRECT VALUE FOR OP - " & KIND);
+          END IF;
+     END GP3;
+
+BEGIN
+     TEST ( "CC3601A", "CHECK THAT PREDEFINED OPERATORS MAY BE " &
+                       "PASSED AS ACTUAL GENERIC SUBPROGRAM " &
+                       "PARAMETERS" );
+
+
+     BEGIN -- CHECKS WITH RELATIONAL OPERATORS AND LOGICAL OPERATORS AS
+           -- ACTUAL PARAMETERS.
+
+          FOR I1 IN BOOLEAN LOOP
+
+               FOR I2 IN BOOLEAN LOOP
+                    COMMENT ( "B1 = " & BOOLEAN'IMAGE (I1) & " AND " &
+                              "B2 = " & BOOLEAN'IMAGE (I2) );
+                    DECLARE
+                         B1 : BOOLEAN := IDENT_BOOL (I1);
+                         B2 : BOOLEAN := IDENT_BOOL (I2);
+
+                         PACKAGE P1 IS 
+                              NEW GP1 (BOOLEAN, NOT B2, B2, 
+                                       """NOT"" - 1", "NOT");
+                         PACKAGE P2 IS 
+                              NEW GP2 (BOOLEAN, B1 OR B2, B1, B2, 
+                                       "OR", "OR");
+                         PACKAGE P3 IS  
+                              NEW GP2 (BOOLEAN, B1 AND B2, B2, B1, 
+                                       "AND", "AND");
+                         PACKAGE P4 IS 
+                              NEW GP2 (BOOLEAN, B1 /= B2, B1, B2, 
+                                       "XOR", "XOR");
+                         PACKAGE P5 IS  
+                              NEW GP2 (BOOLEAN, B1 < B2, B1, B2, 
+                                       "<", "<");
+                         PACKAGE P6 IS 
+                              NEW GP2 (BOOLEAN, B1 <= B2, B1, B2, 
+                                       "<=", "<=");
+                         PACKAGE P7 IS  
+                              NEW GP2 (BOOLEAN, B1 > B2, B1, B2, 
+                                       ">", ">");
+                         PACKAGE P8 IS  
+                              NEW GP2 (BOOLEAN, B1 >= B2, B1, B2, 
+                                       ">=", ">=");
+
+                         TYPE AB IS ARRAY (BOOLEAN RANGE <> ) 
+                              OF BOOLEAN;
+                         AB1 : AB (BOOLEAN) := (B1, B2);
+                         AB2 : AB (BOOLEAN) := (B2, B1);
+                         T : AB (B1 .. B2) := (B1 .. B2 => TRUE);
+                         F : AB (B1 .. B2) := (B1 .. B2 => FALSE);
+                         VB1 : AB (B1 .. B1) := (B1 => B2);
+                         VB2 : AB (B2 .. B2) := (B2 => B1);
+
+                         PACKAGE P9 IS 
+                              NEW GP1 (AB, AB1, NOT AB1, 
+                                       """NOT"" - 2", "NOT");
+                         PACKAGE P10 IS 
+                              NEW GP1 (AB, T, F, 
+                                       """NOT"" - 3", "NOT");
+                         PACKAGE P11 IS 
+                              NEW GP1 (AB, VB2, (B2 => NOT B1), 
+                                       """NOT"" - 4", "NOT");
+                         PACKAGE P12 IS 
+                              NEW GP2 (AB, AB1 AND AB2, AB1, AB2, 
+                                       "AND", "AND");
+                    BEGIN
+                         NULL;
+                    END;
+               END LOOP;
+          END LOOP;
+     END;
+
+     DECLARE -- CHECKS WITH ADDING AND MULTIPLYING OPERATORS, "**", 
+             -- AND "ABS".
+          
+          PACKAGE P1 IS NEW GP1 (INTEGER, -4, -4, """+"" - 1", "+");
+
+          PACKAGE P2 IS NEW GP1 (FLOAT, 4.0, 4.0, """+"" - 2", "+");
+
+          PACKAGE P3 IS NEW GP1 (DURATION, -4.0, -4.0, """+"" - 3",
+                                 "+");
+          PACKAGE P4 IS NEW GP1 (INTEGER, -4, 4, """-"" - 1", "-");
+
+          PACKAGE P5 IS NEW GP1 (FLOAT, 0.0, 0.0, """-"" - 2", "-");
+
+          PACKAGE P6 IS NEW GP1 (DURATION, 1.0, -1.0, """-"" - 3", 
+                                 "-");
+          PACKAGE P7 IS NEW GP2 (INTEGER, 6, 1, 5, """+"" - 1", "+");
+
+          PACKAGE P8 IS NEW GP2 (FLOAT, 6.0, 1.0, 5.0, """+"" - 2", 
+                                 "+");
+          PACKAGE P9 IS NEW GP2 (DURATION, 6.0, 1.0, 5.0, """+"" - 3",
+                                 "+");
+          PACKAGE P10 IS NEW GP2 (INTEGER, 1, 6, 5, """-"" - 1",
+                                  "-" );
+          PACKAGE P11 IS NEW GP2 (DURATION, 11.0, 6.0,-5.0, 
+                                  """-"" - 2", "-");
+          PACKAGE P12 IS NEW GP2 (FLOAT, 1.0, 6.0, 5.0, """-"" - 3",
+                                  "-");
+
+          SUBTYPE SUBINT IS INTEGER RANGE 0 .. 2;
+          TYPE STR IS ARRAY (SUBINT RANGE <>) OF CHARACTER;
+          VSTR : STR (0 .. 1) := "AB";
+
+          PACKAGE P13 IS NEW GP2 (STR, VSTR (0 .. 0) & 
+                                      VSTR (1 .. 1),
+                                      VSTR (0 .. 0),  
+                                      VSTR (1 .. 1), """&"" - 1", "&");
+
+          PACKAGE P14 IS NEW GP2 (STR, VSTR (1 .. 1) & 
+                                      VSTR (0 .. 0),
+                                      VSTR (1 .. 1),  
+                                      VSTR (0 .. 0), """&"" - 2", "&");
+                                        
+          PACKAGE P15 IS NEW GP2 (INTEGER, 0, -1, 0, """*"" - 1", "*");
+
+          PACKAGE P16 IS NEW GP2 (FLOAT, 6.0, 3.0, 2.0, """*"" - 2",
+                                  "*");
+          PACKAGE P17 IS NEW GP2 (INTEGER, 0, 0, 6, """/"" - 1", "/");
+
+          PACKAGE P18 IS NEW GP2 (FLOAT, 3.0, 6.0, 2.0, """/"" - 2",
+                                  "/");
+          PACKAGE P19 IS NEW GP2 (INTEGER, -1, -11, 5, "REM", "REM");
+
+          PACKAGE P20 IS NEW GP2 (INTEGER, 4, -11, 5, "MOD", "MOD");
+          
+          PACKAGE P21 IS NEW GP1 (INTEGER, 5, 5, """ABS"" - 1", "ABS");
+
+          PACKAGE P22 IS NEW GP1 (FLOAT, -5.0, 5.0, """ABS"" - 2", 
+                                  "ABS");
+
+          PACKAGE P23 IS NEW GP1 (DURATION, 0.0, 0.0, """ABS"" - 3", 
+                                  "ABS");
+
+          PACKAGE P24 IS NEW GP2 (INTEGER, 9, 3, 2, """**"" - 1", 
+                                  "**");
+
+          PACKAGE P25 IS NEW GP2 (INTEGER, 1, 5, 0, """**"" - 2",
+                                  "**");
+
+     BEGIN
+          NULL;
+     END;
+
+     DECLARE -- CHECKS WITH ATTRIBUTES.
+          
+          TYPE WEEKDAY IS (MON, TUES, WED, THUR, FRI);
+
+          PACKAGE P1 IS NEW GP1 (WEEKDAY, TUES, WED, "WEEKDAY'SUCC", 
+                                 WEEKDAY'SUCC);
+
+          PACKAGE P2 IS NEW GP1 (WEEKDAY, TUES, MON, "WEEKDAY'PRED", 
+                                 WEEKDAY'PRED);
+          
+          PACKAGE P3 IS NEW GP3 (WEEKDAY, STRING, THUR, "THUR", 
+                                 "WEEKDAY'IMAGE", WEEKDAY'IMAGE);
+
+          PACKAGE P4 IS NEW GP3 (STRING, WEEKDAY, "FRI", FRI, 
+                                 "WEEKDAY'VALUE", WEEKDAY'VALUE);
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC3601A;