From 1bc5aee63eb72b341f506ad058502cd0361f0d10 Mon Sep 17 00:00:00 2001 From: Ben Cheng Date: Tue, 25 Mar 2014 22:37:19 -0700 Subject: Initial checkin of GCC 4.9.0 from trunk (r208799). Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba --- .../gcc/testsuite/ada/acats/tests/cc/cc3605a.ada | 381 +++++++++++++++++++++ 1 file changed, 381 insertions(+) create mode 100644 gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada') diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada new file mode 100644 index 000000000..b9fb50b1b --- /dev/null +++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3605a.ada @@ -0,0 +1,381 @@ +-- CC3605A.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 SOME DIFFERENCES BETWEEN THE FORMAL AND THE +-- ACTUAL SUBPROGRAMS DO NOT INVALIDATE A MATCH. +-- 1) CHECK DIFFERENT PARAMETER NAMES. +-- 2) CHECK DIFFERENT PARAMETER CONSTRAINTS. +-- 3) CHECK ONE PARAMETER CONSTRAINED AND THE OTHER +-- UNCONSTRAINED (WITH ARRAY, RECORD, ACCESS, AND +-- PRIVATE TYPES). +-- 4) CHECK PRESENCE OR ABSENCE OF AN EXPLICIT "IN" MODE +-- INDICATOR. +-- 5) DIFFERENT TYPE MARKS USED TO SPECIFY THE TYPE OF +-- PARAMETERS. + +-- HISTORY: +-- LDC 10/04/88 CREATED ORIGINAL TEST. + +PACKAGE CC3605A_PACK IS + + SUBTYPE INT IS INTEGER RANGE -100 .. 100; + + TYPE PRI_TYPE (SIZE : INT) IS PRIVATE; + + SUBTYPE PRI_CONST IS PRI_TYPE (2); + +PRIVATE + + TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; + + TYPE PRI_TYPE (SIZE : INT) IS + RECORD + SUB_A : ARR_TYPE (1 .. SIZE); + END RECORD; + +END CC3605A_PACK; + + +WITH REPORT; +USE REPORT; +WITH CC3605A_PACK; +USE CC3605A_PACK; + +PROCEDURE CC3605A IS + + SUBTYPE ZERO_TO_TEN IS INTEGER + RANGE IDENT_INT (0) .. IDENT_INT (10); + + SUBTYPE ONE_TO_FIVE IS INTEGER + RANGE IDENT_INT (1) .. IDENT_INT (5); + + SUBPRG_ACT : BOOLEAN := FALSE; +BEGIN + TEST + ("CC3605A", "CHECK THAT SOME DIFFERENCES BETWEEN THE " & + "FORMAL AND THE ACTUAL PARAMETERS DO NOT " & + "INVALIDATE A MATCH"); + +---------------------------------------------------------------------- +-- DIFFERENT PARAMETER NAMES +---------------------------------------------------------------------- + + DECLARE + + PROCEDURE ACT_PROC (DIFF_NAME_PARM : ONE_TO_FIVE) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : ONE_TO_FIVE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (ONE_TO_FIVE'FIRST); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("DIFFERENT PARAMETER NAMES MADE MATCH INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- DIFFERENT PARAMETER CONSTRAINTS +---------------------------------------------------------------------- + + DECLARE + + PROCEDURE ACT_PROC (PARM : ONE_TO_FIVE) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : ZERO_TO_TEN); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (ONE_TO_FIVE'FIRST); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("DIFFERENT PARAMETER CONSTRAINTS MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- ONE PARAMETER CONSTRAINED (ARRAY) +---------------------------------------------------------------------- + + DECLARE + + TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; + + SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST .. + ONE_TO_FIVE'LAST); + + PASSED_PARM : ARR_CONST := (OTHERS => TRUE); + + PROCEDURE ACT_PROC (PARM : ARR_CONST) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : ARR_TYPE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (PASSED_PARM); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("ONE ARRAY PARAMETER CONSTRAINED MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- ONE PARAMETER CONSTRAINED (RECORDS) +---------------------------------------------------------------------- + + DECLARE + + TYPE REC_TYPE (BOL : BOOLEAN) IS + RECORD + SUB_A : INTEGER; + CASE BOL IS + WHEN TRUE => + DSCR_A : INTEGER; + + WHEN FALSE => + DSCR_B : BOOLEAN; + + END CASE; + END RECORD; + + SUBTYPE REC_CONST IS REC_TYPE (TRUE); + + PASSED_PARM : REC_CONST := (TRUE, 1, 2); + + PROCEDURE ACT_PROC (PARM : REC_CONST) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : REC_TYPE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (PASSED_PARM); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("ONE RECORD PARAMETER CONSTRAINED MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- ONE PARAMETER CONSTRAINED (ACCESS) +---------------------------------------------------------------------- + + DECLARE + + TYPE ARR_TYPE IS ARRAY (INTEGER RANGE <>) OF BOOLEAN; + + SUBTYPE ARR_CONST IS ARR_TYPE (ONE_TO_FIVE'FIRST .. + ONE_TO_FIVE'LAST); + + TYPE ARR_ACC_TYPE IS ACCESS ARR_TYPE; + + SUBTYPE ARR_ACC_CONST IS ARR_ACC_TYPE (1 .. 3); + + PASSED_PARM : ARR_ACC_TYPE := NULL; + + PROCEDURE ACT_PROC (PARM : ARR_ACC_CONST) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : ARR_ACC_TYPE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (PASSED_PARM); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("ONE ACCESS PARAMETER CONSTRAINED MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- ONE PARAMETER CONSTRAINED (PRIVATE) +---------------------------------------------------------------------- + + DECLARE + PASSED_PARM : PRI_CONST; + + PROCEDURE ACT_PROC (PARM : PRI_CONST) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : PRI_TYPE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (PASSED_PARM); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("ONE PRIVATE PARAMETER CONSTRAINED MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- PRESENCE (OR ABSENCE) OF AN EXPLICIT "IN" MODE +---------------------------------------------------------------------- + + DECLARE + + PROCEDURE ACT_PROC (PARM : INTEGER) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM : IN INTEGER); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (1); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED + ("PRESENCE OF AN EXPLICIT 'IN' MODE MADE MATCH " & + "INVALID"); + END IF; + END; + +---------------------------------------------------------------------- +-- DIFFERENT TYPE MARKS +---------------------------------------------------------------------- + + DECLARE + + SUBTYPE MARK_1_TYPE IS INTEGER; + + SUBTYPE MARK_2_TYPE IS INTEGER; + + PROCEDURE ACT_PROC (PARM1 : IN MARK_1_TYPE) IS + BEGIN + SUBPRG_ACT := TRUE; + END ACT_PROC; + + GENERIC + + WITH PROCEDURE PASSED_PROC (PARM2 : MARK_2_TYPE); + + PROCEDURE GEN_PROC; + + PROCEDURE GEN_PROC IS + BEGIN + PASSED_PROC (1); + END GEN_PROC; + + PROCEDURE INST_PROC IS NEW GEN_PROC (ACT_PROC); + BEGIN + SUBPRG_ACT := FALSE; + INST_PROC; + IF NOT SUBPRG_ACT THEN + FAILED ("DIFFERENT TYPE MARKS MADE MATCH INVALID"); + END IF; + END; + RESULT; +END CC3605A; -- cgit v1.2.3