--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/testsuite/ada/acats/tests/c6/c61008a.ada	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,266 @@
+-- C61008A.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 CONSTRAINT_ERROR IS NOT RAISED IF THE DEFAULT VALUE
+-- FOR A FORMAL PARAMETER DOES NOT SATISFY THE CONSTRAINTS OF THE 
+-- SUBTYPE_INDICATION WHEN THE DECLARATION IS ELABORATED, ONLY WHEN
+-- THE DEFAULT IS USED.
+
+--   SUBTESTS ARE:
+--        (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND
+--            INITIALIZED WITH A STATIC AGGREGATE.
+--        (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS
+--            INITIALIZED WITH A STATIC VALUE.
+--        (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC
+--            CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE.
+--        (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB-
+--            SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED
+--            WITH A STATIC AGGREGATE.
+--        (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT
+--            INITIALIZED WITH A STATIC AGGREGATE.
+
+-- DAS  1/20/81
+-- SPS 10/26/82
+-- VKG 1/13/83
+-- SPS 2/9/83
+-- BHS 7/9/84
+
+WITH REPORT;
+PROCEDURE C61008A IS
+
+     USE REPORT;
+
+BEGIN
+
+     TEST ("C61008A", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED IF " &
+                      "AN INITIALIZATION VALUE DOES NOT SATISFY " &
+                      "CONSTRAINTS ON A FORMAL PARAMETER");
+
+     --------------------------------------------------
+
+     DECLARE -- (A)
+
+          PROCEDURE PA (I1, I2 : INTEGER) IS
+
+               TYPE A1 IS ARRAY (1..I1,1..I2) OF INTEGER;
+
+               PROCEDURE PA1 (A : A1 := ((1,0),(0,1))) IS
+               BEGIN
+                    FAILED ("BODY OF PA1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PA1");
+               END PA1;
+
+          BEGIN
+               PA1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PA1");
+          END PA;
+
+     BEGIN   -- (A)
+          PA (IDENT_INT(1), IDENT_INT(10));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PA");
+     END;    -- (A)
+
+     --------------------------------------------------
+
+     DECLARE -- (B)
+
+          PROCEDURE PB (I1, I2 : INTEGER) IS
+
+               SUBTYPE INT IS INTEGER RANGE I1..I2;
+
+               PROCEDURE PB1 (I : INT := -1) IS
+               BEGIN
+                    FAILED ("BODY OF PB1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PB1");
+               END PB1;
+
+          BEGIN
+               PB1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PB1");
+          END PB;
+
+     BEGIN   -- (B)
+          PB (IDENT_INT(0), IDENT_INT(63));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PB");
+     END;    -- (B)
+
+     --------------------------------------------------
+
+     DECLARE -- (C)
+
+          PROCEDURE PC (I1, I2 : INTEGER) IS
+               TYPE AR1 IS ARRAY (1..3) OF INTEGER RANGE I1..I2; 
+               TYPE REC IS
+                    RECORD
+                         I : INTEGER RANGE I1..I2;
+                         A : AR1 ;
+                    END RECORD;
+
+               PROCEDURE PC1 (R : REC := (-3,(0,2,3))) IS
+               BEGIN
+                    FAILED ("BODY OF PC1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PC1");
+               END PC1;
+
+          BEGIN
+               PC1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PC1");
+          END PC;
+
+     BEGIN   -- (C)
+          PC (IDENT_INT(1), IDENT_INT(3));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PC");
+     END;    -- (C)
+
+     --------------------------------------------------
+
+     DECLARE -- (D1)
+
+          PROCEDURE P1D (I1, I2 : INTEGER) IS
+
+               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+
+               PROCEDURE P1D1 (A : A1 := ((1,-1),(1,2))) IS
+               BEGIN
+                    FAILED ("BODY OF P1D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN P1D1");
+               END P1D1;
+
+          BEGIN
+               P1D1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P1D1");
+          END P1D;
+
+     BEGIN   -- (D1)
+          P1D (IDENT_INT(1), IDENT_INT(2));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO P1D");
+     END;    -- (D1)
+
+     --------------------------------------------------
+
+     DECLARE -- (D2)
+
+          PROCEDURE P2D (I1, I2 : INTEGER) IS
+               
+               TYPE A1 IS ARRAY (1..2,1..2) OF INTEGER RANGE I1..I2;
+
+               PROCEDURE P2D1 (A : A1 := (3..4 => (1,2))) IS
+               BEGIN
+                    FAILED ("BODY OF P2D1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN P2D1");
+               END P2D1;
+
+          BEGIN
+               P2D1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - P2D1");
+          END P2D;
+
+     BEGIN  -- (D2)
+          P2D (IDENT_INT(1), IDENT_INT(2));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO P2D");
+     END;   -- (D2)
+
+     --------------------------------------------------
+
+     DECLARE -- (E)
+
+          PROCEDURE PE (I1, I2 : INTEGER) IS
+               SUBTYPE INT IS INTEGER RANGE 0..10;
+               TYPE ARR IS ARRAY (1..3) OF INT;
+               TYPE REC (I : INT) IS
+                    RECORD
+                         A : ARR;
+                    END RECORD;
+
+               SUBTYPE REC4 IS REC(I1);
+
+               PROCEDURE PE1 (R : REC4 := (3,(1,2,3))) IS
+               BEGIN
+                    FAILED ("BODY OF PE1 EXECUTED");
+               EXCEPTION
+                    WHEN OTHERS =>
+                         FAILED ("EXCEPTION RAISED IN PE1");
+               END PE1;
+
+          BEGIN
+               PE1;
+          EXCEPTION
+               WHEN CONSTRAINT_ERROR =>
+                    NULL;
+               WHEN OTHERS =>
+                    FAILED ("WRONG EXCEPTION RAISED - PE1");
+          END PE;
+
+     BEGIN   -- (E)
+          PE (IDENT_INT(4), IDENT_INT(10));
+     EXCEPTION
+          WHEN OTHERS =>
+               FAILED ("EXCEPTION RAISED IN CALL TO PE");
+     END;    -- (E)
+
+     --------------------------------------------------
+
+     RESULT;
+
+END C61008A;