1 files changed, 161 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada
new file mode 100644
index 000000000..187033773
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c3/c37405a.ada
@@ -0,0 +1,161 @@
+-- C37405A.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 WHEN ASSIGNING TO A CONSTRAINED OR UNCONSTRAINED
+-- OBJECT OR FORMAL PARAMETER OF A TYPE DECLARED WITH DEFAULT
+-- DISCRIMINANTS, THE ASSIGNMENT DOES NOT CHANGE THE 'CONSTRAINED
+-- ATTRIBUTE VALUE ASSOCIATED WITH THE OBJECT OR PARAMETER.
+ 
+-- ASL 7/21/81
+-- TBN 1/20/86     RENAMED FROM C37209A.ADA AND REVISED THE ASSIGNMENTS 
+--                 OF CONSTRAINED AND UNCONSTRAINED OBJECTS TO ARRAY AND
+--                 RECORD COMPONENTS.
+
+WITH REPORT; USE REPORT;
+PROCEDURE C37405A IS
+ 
+     TYPE REC(DISC : INTEGER := 25) IS
+          RECORD
+               COMP : INTEGER;
+          END RECORD;
+ 
+     SUBTYPE CONSTR IS REC(10);
+     SUBTYPE UNCONSTR IS REC;
+
+     TYPE REC_C IS 
+          RECORD
+               COMP: CONSTR;
+          END RECORD;
+
+     TYPE REC_U IS
+          RECORD
+               COMP: UNCONSTR;
+          END RECORD;
+ 
+     C1,C2 : CONSTR;
+     U1,U2 : UNCONSTR;
+-- C2 AND U2 ARE NOT PASSED TO EITHER PROC1 OR PROC2.
+
+     ARR_C : ARRAY (1..5) OF CONSTR;
+     ARR_U : ARRAY (1..5) OF UNCONSTR;
+
+     REC_COMP_C : REC_C;
+     REC_COMP_U : REC_U;
+ 
+     PROCEDURE PROC11(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          PARM := C2;
+          IF IDENT_BOOL(B) /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 1");
+          END IF;
+     END PROC11;
+
+     PROCEDURE PROC12(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          PARM := U2;
+          IF B /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 2");
+          END IF;
+     END PROC12;
+
+     PROCEDURE PROC1(PARM : IN OUT UNCONSTR; B : IN BOOLEAN) IS
+     BEGIN
+          IF B /= PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "PASSING PARAMETER");
+          END IF;
+ 
+          PROC11(PARM, B);
+ 
+          PROC12(PARM, B);
+
+     END PROC1;
+ 
+     PROCEDURE PROC2(PARM : IN OUT CONSTR) IS
+     BEGIN
+          COMMENT ("CALLING PROC1 FROM PROC2");   -- IN CASE TEST FAILS.
+          PROC1(PARM,TRUE);
+          PARM := U2;
+          IF NOT PARM'CONSTRAINED THEN
+               FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY " &
+                       "ASSIGNMENT - 3");
+          END IF;
+     END PROC2;
+BEGIN
+     TEST("C37405A", "'CONSTRAINED ATTRIBUTE OF OBJECTS, FORMAL " &
+                     "PARAMETERS CANNOT BE CHANGED BY ASSIGNMENT");
+ 
+     C2 := (DISC => IDENT_INT(10), COMP => 3);
+     U2 := (DISC => IDENT_INT(10), COMP => 4);
+
+     ARR_C := (1..5 => U2);
+     ARR_U := (1..5 => C2);
+
+     REC_COMP_C := (COMP => U2);
+     REC_COMP_U := (COMP => C2);
+ 
+     C1 := U2;
+     U1 := C2;
+ 
+     IF U1'CONSTRAINED OR NOT C1'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 4");
+     END IF;
+
+     IF ARR_U(3)'CONSTRAINED OR NOT ARR_C(4)'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 5");
+     END IF;
+
+     IF REC_COMP_U.COMP'CONSTRAINED
+         OR NOT REC_COMP_C.COMP'CONSTRAINED THEN
+          FAILED ("'CONSTRAINED ATTRIBUTE CHANGED BY ASSIGNMENT - 6");
+     END IF;
+ 
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(C1,TRUE);
+     PROC2(C1);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(U1,FALSE);
+     PROC2(U1);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(ARR_C(4), TRUE);
+     PROC2(ARR_C(5));
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(ARR_U(2), FALSE);
+     PROC2(ARR_U(3));
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(REC_COMP_C.COMP, TRUE);
+     PROC2(REC_COMP_C.COMP);
+
+     COMMENT("CALLING PROC1 DIRECTLY");
+     PROC1(REC_COMP_U.COMP, FALSE);
+     PROC2(REC_COMP_U.COMP);
+ 
+     RESULT;
+END C37405A;