aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada207
1 files changed, 207 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
new file mode 100644
index 000000000..cd238c17a
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc3106b.ada
@@ -0,0 +1,207 @@
+-- CC3106B.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 THE FORMAL PARAMETER DENOTES THE ACTUAL
+-- IN AN INSTANTIATION.
+
+-- HISTORY:
+-- LDC 06/20/88 CREATED ORIGINAL TEST
+-- EDWARD V. BERARD, 10 AUGUST 1990 ADDED CHECKS FOR MULTI-
+-- DIMENSIONAL ARRAYS
+
+WITH REPORT ;
+
+PROCEDURE CC3106B IS
+
+BEGIN -- CC3106B
+
+ REPORT.TEST("CC3106B","CHECK THAT THE FORMAL PARAMETER DENOTES " &
+ "THE ACTUAL IN AN INSTANTIATION");
+
+ LOCAL_BLOCK:
+
+ DECLARE
+
+ SUBTYPE SM_INT IS INTEGER RANGE 0..15 ;
+ TYPE PCK_BOL IS ARRAY (5..18) OF BOOLEAN ;
+ PRAGMA PACK(PCK_BOL) ;
+
+ SHORT_START : CONSTANT := -100 ;
+ SHORT_END : CONSTANT := 100 ;
+ TYPE SHORT_RANGE IS RANGE SHORT_START .. SHORT_END ;
+
+ SUBTYPE REALLY_SHORT IS SHORT_RANGE RANGE -9 .. 0 ;
+
+ TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
+ SEP, OCT, NOV, DEC) ;
+
+ SUBTYPE FIRST_HALF IS MONTH_TYPE RANGE JAN .. JUN ;
+
+ TYPE DAY_TYPE IS RANGE 1 .. 31 ;
+ TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
+ TYPE DATE IS RECORD
+ MONTH : MONTH_TYPE ;
+ DAY : DAY_TYPE ;
+ YEAR : YEAR_TYPE ;
+ END RECORD ;
+
+ TODAY : DATE := (MONTH => AUG,
+ DAY => 8,
+ YEAR => 1990) ;
+
+ FIRST_DATE : DATE := (DAY => 6,
+ MONTH => JUN,
+ YEAR => 1967) ;
+
+ WALL_DATE : DATE := (MONTH => NOV,
+ DAY => 9,
+ YEAR => 1989) ;
+
+ SUBTYPE FIRST_FIVE IS CHARACTER RANGE 'A' .. 'E' ;
+
+ TYPE THREE_DIMENSIONAL IS ARRAY (REALLY_SHORT,
+ FIRST_HALF,
+ FIRST_FIVE) OF DATE ;
+
+ TD_ARRAY : THREE_DIMENSIONAL := (THREE_DIMENSIONAL'RANGE =>
+ (THREE_DIMENSIONAL'RANGE (2) =>
+ (THREE_DIMENSIONAL'RANGE (3) =>
+ TODAY))) ;
+
+ TASK TYPE TSK IS
+ ENTRY ENT_1;
+ ENTRY ENT_2;
+ ENTRY ENT_3;
+ END TSK;
+
+ GENERIC
+
+ TYPE GEN_TYPE IS (<>);
+ GEN_BOLARR : IN OUT PCK_BOL;
+ GEN_TYP : IN OUT GEN_TYPE;
+ GEN_TSK : IN OUT TSK;
+ TEST_VALUE : IN DATE ;
+ TEST_CUBE : IN OUT THREE_DIMENSIONAL ;
+
+ PACKAGE P IS
+ PROCEDURE GEN_PROC1 ;
+ PROCEDURE GEN_PROC2 ;
+ PROCEDURE GEN_PROC3 ;
+ PROCEDURE ARRAY_TEST ;
+ END P;
+
+ ACT_BOLARR : PCK_BOL := (OTHERS => FALSE);
+ SI : SM_INT := 0 ;
+ T : TSK;
+
+ PACKAGE BODY P IS
+
+ PROCEDURE GEN_PROC1 IS
+ BEGIN -- GEN_PROC1
+ GEN_BOLARR(14) := REPORT.IDENT_BOOL(TRUE);
+ GEN_TYP := GEN_TYPE'VAL(4);
+ IF ACT_BOLARR(14) /= TRUE OR SI /= REPORT.IDENT_INT(4)
+ THEN
+ REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+ "INSTANTIATED VALUES");
+ END IF;
+ END GEN_PROC1;
+
+ PROCEDURE GEN_PROC2 IS
+ BEGIN -- GEN_PROC2
+ IF GEN_BOLARR(9) /= REPORT.IDENT_BOOL(TRUE) OR
+ GEN_TYPE'POS(GEN_TYP) /= REPORT.IDENT_INT(2) THEN
+ REPORT.FAILED("VALUES ARE DIFFERENT THAN " &
+ "VALUES ASSIGNED IN THE MAIN " &
+ "PROCEDURE");
+ END IF;
+ GEN_BOLARR(18) := TRUE;
+ GEN_TYP := GEN_TYPE'VAL(9);
+ END GEN_PROC2;
+
+ PROCEDURE GEN_PROC3 IS
+ BEGIN -- GEN_PROC3
+ GEN_TSK.ENT_2;
+ END GEN_PROC3 ;
+
+ PROCEDURE ARRAY_TEST IS
+ BEGIN -- ARRAY_TEST
+
+ TEST_CUBE (0, JUN, 'C') := TEST_VALUE ;
+
+ IF (TD_ARRAY (0, JUN, 'C') /= TEST_VALUE) OR
+ (TEST_CUBE (-5, MAR, 'A') /= WALL_DATE) THEN
+ REPORT.FAILED ("MULTI-DIMENSIONAL ARRAY VALUES ARE " &
+ "DIFFERENT THAN THE VALUES ASSIGNED " &
+ "IN THE MAIN AND ARRAY_TEST PROCEDURES.") ;
+ END IF ;
+
+ END ARRAY_TEST ;
+
+ END P ;
+
+ TASK BODY TSK IS
+ BEGIN -- TSK
+ ACCEPT ENT_1 DO
+ REPORT.COMMENT("TASK ENTRY 1 WAS CALLED");
+ END;
+ ACCEPT ENT_2 DO
+ REPORT.COMMENT("TASK ENTRY 2 WAS CALLED");
+ END;
+ ACCEPT ENT_3 DO
+ REPORT.COMMENT("TASK ENTRY 3 WAS CALLED");
+ END;
+ END TSK;
+
+ PACKAGE INSTA1 IS NEW P (GEN_TYPE => SM_INT,
+ GEN_BOLARR => ACT_BOLARR,
+ GEN_TYP => SI,
+ GEN_TSK => T,
+ TEST_VALUE => FIRST_DATE,
+ TEST_CUBE => TD_ARRAY) ;
+
+ BEGIN -- LOCAL_BLOCK
+
+ INSTA1.GEN_PROC1;
+ ACT_BOLARR(9) := TRUE;
+ SI := 2;
+ INSTA1.GEN_PROC2;
+ IF ACT_BOLARR(18) /= REPORT.IDENT_BOOL(TRUE) OR
+ SI /= REPORT.IDENT_INT(9) THEN
+ REPORT.FAILED("VALUES ARE DIFFERENT THAN VALUES " &
+ "ASSIGNED IN THE GENERIC PROCEDURE");
+ END IF;
+
+ T.ENT_1;
+ INSTA1.GEN_PROC3;
+ T.ENT_3;
+
+ TD_ARRAY (-5, MAR, 'A') := WALL_DATE ;
+ INSTA1.ARRAY_TEST ;
+
+ END LOCAL_BLOCK;
+
+ REPORT.RESULT;
+
+END CC3106B ;