diff options
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada')
| -rw-r--r-- | gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada | 470 |
1 files changed, 470 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada new file mode 100644 index 000000000..0f8fcfd6f --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3017b.ada @@ -0,0 +1,470 @@ +-- CC3017B.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 AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A +-- PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST +-- DECLARE A FUNCTION. 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. + +-- EDWARD V. BERARD, 7 AUGUST 1990 + +WITH REPORT; + +PROCEDURE CC3017B IS + +BEGIN + + REPORT.TEST ("CC3017B", "CHECK THAT AN INSTANCE OF A GENERIC " & + "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " & + "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " & + "FUNCTION. CHECK THAT CONSTRAINT_ERROR IS NOT " & + "RAISED IF AN INITIALIZATION VALUE DOES NOT SATISFY " & + "CONSTRAINTS ON A FORMAL PARAMETER"); + + -------------------------------------------------- + + NONSTAT_ARRAY_PARMS: + + DECLARE + +-- (A) ARRAY PARAMETERS CONSTRAINED WITH NONSTATIC BOUNDS AND +-- INITIALIZED WITH A STATIC AGGREGATE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE ; + + PROCEDURE PA (FIRST : IN INTEGER_TYPE ; + SECOND : IN INTEGER_TYPE) ; + + PROCEDURE PA (FIRST : IN INTEGER_TYPE ; + SECOND : IN INTEGER_TYPE) IS + + TYPE A1 IS ARRAY (INTEGER_TYPE RANGE LOWER .. FIRST, + INTEGER_TYPE RANGE LOWER .. SECOND) + OF INTEGER_TYPE; + + PROCEDURE PA1 (A : A1 := ((LOWER,UPPER),(UPPER,UPPER))) + IS + BEGIN + REPORT.FAILED ("BODY OF PA1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN PA1"); + END PA1; + + BEGIN -- PA + PA1; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - PA1"); + END PA; + + PROCEDURE NEW_PA IS NEW PA (INTEGER_TYPE => NUMBER, + LOWER => 1, + UPPER => 50) ; + + BEGIN -- NONSTAT_ARRAY_PARMS + + NEW_PA (FIRST => NUMBER (25), + SECOND => NUMBER (75)); + + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PA"); + + END NONSTAT_ARRAY_PARMS ; + + -------------------------------------------------- + + SCALAR_NON_STATIC: + + DECLARE + +-- (B) A SCALAR PARAMETER WITH NON-STATIC RANGE CONSTRAINTS +-- INITIALIZED WITH A STATIC VALUE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + STATIC_VALUE : IN INTEGER_TYPE ; + + PROCEDURE PB (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) ; + + PROCEDURE PB (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) IS + + SUBTYPE INT IS INTEGER_TYPE RANGE LOWER .. UPPER ; + + PROCEDURE PB1 (I : INT := STATIC_VALUE) IS + BEGIN -- PB1 + REPORT.FAILED ("BODY OF PB1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN PB1"); + END PB1; + + BEGIN -- PB + PB1; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - PB1"); + END PB; + + PROCEDURE NEW_PB IS NEW PB (INTEGER_TYPE => NUMBER, + STATIC_VALUE => 20) ; + + BEGIN -- SCALAR_NON_STATIC + + NEW_PB (LOWER => NUMBER (25), + UPPER => NUMBER (75)); + + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PB"); + END SCALAR_NON_STATIC ; + + -------------------------------------------------- + + REC_NON_STAT_COMPS: + + DECLARE + +-- (C) A RECORD PARAMETER WHOSE COMPONENTS HAVE NON-STATIC +-- CONSTRAINTS INITIALIZED WITH A STATIC AGGREGATE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + F_STATIC_VALUE : IN INTEGER_TYPE ; + S_STATIC_VALUE : IN INTEGER_TYPE ; + T_STATIC_VALUE : IN INTEGER_TYPE ; + L_STATIC_VALUE : IN INTEGER_TYPE ; + + PROCEDURE PC (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) ; + + PROCEDURE PC (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) IS + + SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE + RANGE LOWER .. UPPER ; + TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF + SUBINTEGER_TYPE ; + TYPE REC IS + RECORD + FIRST : SUBINTEGER_TYPE ; + SECOND : AR1 ; + END RECORD; + + PROCEDURE PC1 (R : REC := (F_STATIC_VALUE, + (S_STATIC_VALUE, + T_STATIC_VALUE, + L_STATIC_VALUE))) IS + BEGIN -- PC1 + REPORT.FAILED ("BODY OF PC1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN PC1"); + END PC1; + + BEGIN -- PC + PC1; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - PC1"); + END PC; + + PROCEDURE NEW_PC IS NEW PC (INTEGER_TYPE => NUMBER, + F_STATIC_VALUE => 15, + S_STATIC_VALUE => 19, + T_STATIC_VALUE => 85, + L_STATIC_VALUE => 99) ; + + BEGIN -- REC_NON_STAT_COMPS + NEW_PC (LOWER => 20, + UPPER => 80); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PC"); + END REC_NON_STAT_COMPS ; + + -------------------------------------------------- + + FIRST_STATIC_ARRAY: + + DECLARE + +-- (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB- +-- SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED +-- WITH A STATIC AGGREGATE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + F_STATIC_VALUE : IN INTEGER_TYPE ; + S_STATIC_VALUE : IN INTEGER_TYPE ; + T_STATIC_VALUE : IN INTEGER_TYPE ; + L_STATIC_VALUE : IN INTEGER_TYPE ; + A_STATIC_VALUE : IN INTEGER_TYPE ; + B_STATIC_VALUE : IN INTEGER_TYPE ; + C_STATIC_VALUE : IN INTEGER_TYPE ; + D_STATIC_VALUE : IN INTEGER_TYPE ; + + PROCEDURE P1D (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) ; + + PROCEDURE P1D (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) IS + + SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE + RANGE LOWER .. UPPER ; + + TYPE A1 IS ARRAY (INTEGER_TYPE RANGE + F_STATIC_VALUE .. S_STATIC_VALUE, + INTEGER_TYPE RANGE + T_STATIC_VALUE .. L_STATIC_VALUE) + OF SUBINTEGER_TYPE ; + + PROCEDURE P1D1 (A : A1 := + ((A_STATIC_VALUE, B_STATIC_VALUE), + (C_STATIC_VALUE, D_STATIC_VALUE))) IS + BEGIN -- P1D1 + REPORT.FAILED ("BODY OF P1D1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN P1D1"); + END P1D1; + + BEGIN -- P1D + P1D1 ; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - P1D1"); + END P1D; + + PROCEDURE NEW_P1D IS NEW P1D (INTEGER_TYPE => NUMBER, + F_STATIC_VALUE => 21, + S_STATIC_VALUE => 37, + T_STATIC_VALUE => 67, + L_STATIC_VALUE => 79, + A_STATIC_VALUE => 11, + B_STATIC_VALUE => 88, + C_STATIC_VALUE => 87, + D_STATIC_VALUE => 13) ; + + BEGIN -- FIRST_STATIC_ARRAY + NEW_P1D (LOWER => 10, + UPPER => 90); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P1D"); + END FIRST_STATIC_ARRAY ; + + -------------------------------------------------- + + SECOND_STATIC_ARRAY: + + DECLARE + +-- (D) AN ARRAY PARAMETER CONSTRAINED WITH STATIC BOUNDS ON SUB- +-- SCRIPTS AND NON-STATIC BOUNDS ON COMPONENTS, INITIALIZED +-- WITH A STATIC AGGREGATE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + F_STATIC_VALUE : IN INTEGER_TYPE ; + S_STATIC_VALUE : IN INTEGER_TYPE ; + T_STATIC_VALUE : IN INTEGER_TYPE ; + L_STATIC_VALUE : IN INTEGER_TYPE ; + A_STATIC_VALUE : IN INTEGER_TYPE ; + B_STATIC_VALUE : IN INTEGER_TYPE ; + + PROCEDURE P2D (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) ; + + PROCEDURE P2D (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) IS + + SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE + RANGE LOWER .. UPPER ; + + TYPE A1 IS ARRAY (INTEGER_TYPE RANGE + F_STATIC_VALUE .. S_STATIC_VALUE, + INTEGER_TYPE RANGE + T_STATIC_VALUE .. L_STATIC_VALUE) + OF SUBINTEGER_TYPE ; + + PROCEDURE P2D1 (A : A1 := + (F_STATIC_VALUE .. S_STATIC_VALUE => + (A_STATIC_VALUE, B_STATIC_VALUE))) IS + BEGIN -- P2D1 + REPORT.FAILED ("BODY OF P2D1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN P2D1"); + END P2D1; + + BEGIN -- P2D + P2D1; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - P2D1"); + END P2D; + + PROCEDURE NEW_P2D IS NEW P2D (INTEGER_TYPE => NUMBER, + F_STATIC_VALUE => 21, + S_STATIC_VALUE => 37, + T_STATIC_VALUE => 67, + L_STATIC_VALUE => 79, + A_STATIC_VALUE => 7, + B_STATIC_VALUE => 93) ; + + BEGIN -- SECOND_STATIC_ARRAY + NEW_P2D (LOWER => 5, + UPPER => 95); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_P2D"); + END SECOND_STATIC_ARRAY ; + + -------------------------------------------------- + + REC_NON_STATIC_CONS: + + DECLARE + +-- (E) A RECORD PARAMETER WITH A NON-STATIC CONSTRAINT +-- INITIALIZED WITH A STATIC AGGREGATE. + + TYPE NUMBER IS RANGE 1 .. 100 ; + + GENERIC + + TYPE INTEGER_TYPE IS RANGE <> ; + F_STATIC_VALUE : IN INTEGER_TYPE ; + S_STATIC_VALUE : IN INTEGER_TYPE ; + T_STATIC_VALUE : IN INTEGER_TYPE ; + L_STATIC_VALUE : IN INTEGER_TYPE ; + D_STATIC_VALUE : IN INTEGER_TYPE ; + + PROCEDURE PE (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) ; + + PROCEDURE PE (LOWER : IN INTEGER_TYPE ; + UPPER : IN INTEGER_TYPE) IS + + SUBTYPE SUBINTEGER_TYPE IS INTEGER_TYPE + RANGE LOWER .. UPPER ; + TYPE AR1 IS ARRAY (INTEGER RANGE 1..3) OF + SUBINTEGER_TYPE ; + + TYPE REC (DISCRIM : SUBINTEGER_TYPE) IS + RECORD + FIRST : SUBINTEGER_TYPE ; + SECOND : AR1 ; + END RECORD ; + + SUBTYPE REC4 IS REC (LOWER) ; + + PROCEDURE PE1 (R : REC4 := (D_STATIC_VALUE, + F_STATIC_VALUE, + (S_STATIC_VALUE, + T_STATIC_VALUE, + L_STATIC_VALUE))) IS + BEGIN -- PE1 + REPORT.FAILED ("BODY OF PE1 EXECUTED"); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN PE1"); + END PE1; + + BEGIN -- PE + PE1; + EXCEPTION + WHEN CONSTRAINT_ERROR => + NULL; + WHEN OTHERS => + REPORT.FAILED ("WRONG EXCEPTION RAISED - PE1"); + END PE; + + PROCEDURE NEW_PE IS NEW PE (INTEGER_TYPE => NUMBER, + F_STATIC_VALUE => 37, + S_STATIC_VALUE => 21, + T_STATIC_VALUE => 67, + L_STATIC_VALUE => 79, + D_STATIC_VALUE => 44) ; + + BEGIN -- REC_NON_STATIC_CONS + NEW_PE (LOWER => 2, + UPPER => 99); + EXCEPTION + WHEN OTHERS => + REPORT.FAILED ("EXCEPTION RAISED IN CALL TO NEW_PE"); + END REC_NON_STATIC_CONS ; + + -------------------------------------------------- + + REPORT.RESULT; + +END CC3017B; |