Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/ada/acats/tests/cc/cc3017b.ada @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children |
line wrap: on
line source
-- 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;