1 files changed, 138 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
new file mode 100644
index 000000000..b8eeae495
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc1207b.ada
@@ -0,0 +1,138 @@
+-- CC1207B.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.
+--*
+-- OBJECTIVE:
+--     CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH DISCRIMINANTS IS
+--     ALLOWED AS THE TYPE OF A SUBPROGRAM OR AN ENTRY FORMAL
+--     PARAMETER, AND AS THE TYPE OF A GENERIC FORMAL OBJECT PARAMETER,
+--     AS A GENERIC ACTUAL PARAMETER, AND IN A MEMBERSHIP TEST, IN A
+--     SUBTYPE DECLARATION, IN AN ACCESS TYPE DEFINITION, AND IN A
+--     DERIVED TYPE DEFINITION.
+
+-- HISTORY:
+--     BCB 08/04/88  CREATED ORIGINAL TEST.
+
+WITH REPORT; USE REPORT;
+
+PROCEDURE CC1207B IS
+
+     GENERIC
+          TYPE X (L : INTEGER) IS PRIVATE;
+     PACKAGE PACK IS
+     END PACK;
+
+BEGIN
+     TEST ("CC1207B", "CHECK THAT AN UNCONSTRAINED FORMAL TYPE WITH " &
+                      "DISCRIMINANTS IS ALLOWED AS THE TYPE OF A " &
+                      "SUBPROGRAM OR AN ENTRY FORMAL PARAMETER, AND " &
+                      "AS THE TYPE OF A GENERIC FORMAL OBJECT " &
+                      "PARAMETER, AS A GENERIC ACTUAL PARAMETER, AND " &
+                      "IN A MEMBERSHIP TEST, IN A SUBTYPE " &
+                      "DECLARATION, IN AN ACCESS TYPE DEFINITION, " &
+                      "AND IN A DERIVED TYPE DEFINITION");
+
+     DECLARE
+          TYPE REC (D : INTEGER := 3) IS RECORD
+               NULL;
+          END RECORD;
+
+          GENERIC
+               TYPE R (D : INTEGER) IS PRIVATE;
+               OBJ : R;
+          PACKAGE P IS
+               PROCEDURE S (X : R);
+
+               TASK T IS
+                    ENTRY E (Y : R);
+               END T;
+
+               SUBTYPE SUB_R IS R;
+
+               TYPE ACC_R IS ACCESS R;
+
+               TYPE NEW_R IS NEW R;
+
+               BOOL : BOOLEAN := (OBJ IN R);
+
+               SUB_VAR : SUB_R(5);
+
+               ACC_VAR : ACC_R := NEW R(5);
+
+               NEW_VAR : NEW_R(5);
+
+               PACKAGE NEW_PACK IS NEW PACK (R);
+          END P;
+
+          REC_VAR : REC(5) := (D => 5);
+
+          PACKAGE BODY P IS
+               PROCEDURE S (X : R) IS
+               BEGIN
+                    IF NOT EQUAL(X.D,5) THEN
+                         FAILED ("WRONG DISCRIMINANT VALUE - S");
+                    END IF;
+               END S;
+
+               TASK BODY T IS
+               BEGIN
+                    ACCEPT E (Y : R) DO
+                         IF NOT EQUAL(Y.D,5) THEN
+                              FAILED ("WRONG DISCRIMINANT VALUE - T");
+                         END IF;
+                    END E;
+               END T;
+          BEGIN
+               IF NOT EQUAL(OBJ.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE");
+               END IF;
+
+               S (OBJ);
+
+               T.E (OBJ);
+
+               IF NOT EQUAL(SUB_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - SUBTYPE");
+               END IF;
+
+               IF NOT EQUAL(ACC_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - ACCESS");
+               END IF;
+
+               IF NOT EQUAL(NEW_VAR.D,5) THEN
+                    FAILED ("IMPROPER DISCRIMINANT VALUE - DERIVED");
+               END IF;
+
+               IF NOT BOOL THEN
+                    FAILED ("IMPROPER RESULT FROM MEMBERSHIP TEST");
+               END IF;
+          END P;
+
+          PACKAGE NEW_P IS NEW P (REC,REC_VAR);
+
+     BEGIN
+          NULL;
+     END;
+
+     RESULT;
+END CC1207B;