aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada196
1 files changed, 196 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
new file mode 100644
index 000000000..ac7fec806
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c6/c64201c.ada
@@ -0,0 +1,196 @@
+-- C64201C.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 INITIALIZATION OF IN PARAMETERS OF A COMPOSITE
+-- TYPE HAVING AT LEAST ONE COMPONENT (INCLUDING COMPONENTS
+-- OF COMPONENTS) OF A TASK TYPE IS PERMITTED.
+-- (SEE ALSO 7.4.4/T2 FOR TESTS OF LIMITED PRIVATE TYPES.)
+
+-- CVP 5/14/81
+-- ABW 7/1/82
+-- BHS 7/9/84
+
+WITH REPORT;
+USE REPORT;
+PROCEDURE C64201C IS
+
+
+ GLOBAL : INTEGER := 10;
+
+
+ TASK TYPE T IS
+ ENTRY E (X : IN OUT INTEGER);
+ END;
+
+ TYPE REC_T IS
+ RECORD
+ TT : T;
+ BB : BOOLEAN := TRUE;
+ END RECORD;
+
+ TYPE REC_REC_T IS
+ RECORD
+ RR : REC_T;
+ END RECORD;
+
+ TYPE ARR_T IS ARRAY (1 .. 2) OF T;
+
+ TYPE ARR_REC_T IS ARRAY (1 .. 2) OF REC_T;
+
+ RT1, RT2 : REC_T;
+ RRT1, RRT2 : REC_REC_T;
+ AT1, AT2 : ARR_T;
+ ART1, ART2 : ARR_REC_T;
+
+
+ TASK BODY T IS
+ BEGIN
+ ACCEPT E (X : IN OUT INTEGER) DO
+ X := X - 1;
+ END E;
+ ACCEPT E (X : IN OUT INTEGER) DO
+ X := X + 1;
+ END E;
+ END T;
+
+
+ PROCEDURE PROC1A (P1X : REC_T := RT1) IS
+ BEGIN
+ IF P1X.BB THEN -- EXPECT RT2 PASSED.
+ FAILED( "RECORD OF TASK NOT PASSED, DEFAULT EMPLOYED" );
+ END IF;
+ END PROC1A;
+
+ PROCEDURE PROC1B (P1X : REC_T := RT1) IS
+ BEGIN
+ IF NOT P1X.BB THEN -- EXPECT DEFAULT USED.
+ FAILED( "DEFAULT RECORD OF TASK NOT EMPLOYED" );
+ END IF;
+ END PROC1B;
+
+
+ PROCEDURE PROC2A (P2X : REC_REC_T := RRT1) IS
+ BEGIN
+ IF P2X.RR.BB THEN -- EXPECT RRT2 PASSED.
+ FAILED( "RECORD OF RECORD OF TASK NOT PASSED, " &
+ "DEFAULT EMPLOYED" );
+ END IF;
+ END PROC2A;
+
+ PROCEDURE PROC2B (P2X : REC_REC_T := RRT1) IS
+ BEGIN
+ IF NOT P2X.RR.BB THEN -- EXPECT DEFAULT USED.
+ FAILED( "DEFAULT RECORD OF RECORD OF TASK " &
+ "NOT EMPLOYED" );
+ END IF;
+ END PROC2B;
+
+
+ PROCEDURE PROC3 (P3X : ARR_T := AT1) IS
+ BEGIN
+ P3X(1).E (X => GLOBAL); -- CALL TO AT2(1).E,
+ -- GLOBAL => GLOBAL - 1.
+ END PROC3;
+
+ PROCEDURE PROC4 (P4X : ARR_T := AT1) IS
+ BEGIN
+ P4X(1).E (X => GLOBAL); -- CALL TO DEFAULT AT1(1).E,
+ -- GLOBAL => GLOBAL - 1.
+ IF GLOBAL /= IDENT_INT(8) THEN
+ FAILED( "ARRAY OF TASKS NOT PASSED " &
+ "CORRECTLY IN PROC3" );
+ END IF;
+ END PROC4;
+
+ PROCEDURE PROC5 (P5X : ARR_REC_T := ART1) IS
+ BEGIN
+ P5X(1).TT.E (X => GLOBAL); -- CALL TO ART2(1).TT.E,
+ -- GLOBAL => GLOBAL - 1.
+ END PROC5;
+
+ PROCEDURE PROC6 (P6X : ARR_REC_T := ART1) IS
+ BEGIN
+ P6X(1).TT.E (X => GLOBAL); -- CALL DEFAULT ART1(1).TT.E,
+ -- GLOBAL => GLOBAL - 1.
+ IF GLOBAL /= IDENT_INT(8) THEN
+ FAILED( "ARRAY OF RECORDS OF TASKS NOT " &
+ "PASSED IN PROC5" );
+ END IF;
+ END PROC6;
+
+ PROCEDURE TERM (TSK : T; NUM : CHARACTER) IS
+ BEGIN
+ IF NOT TSK'TERMINATED THEN
+ ABORT TSK;
+ COMMENT ("ABORTING TASK " & NUM);
+ END IF;
+ END TERM;
+
+
+BEGIN
+
+ TEST( "C64201C" , "CHECK THAT INITIALIZATION OF IN " &
+ "PARAMETERS OF A COMPOSITE TYPE " &
+ "IS PERMITTED" );
+
+ RT2.BB := FALSE;
+ RRT2.RR.BB := FALSE;
+
+ PROC1A(RT2); -- NO ENTRY CALL
+ PROC1B; -- NO ENTRY CALL
+ PROC2A(RRT2); -- NO ENTRY CALL
+ PROC2B; -- NO ENTRY CALL
+
+ PROC3(AT2); -- CALL AT2(1).E
+ IF GLOBAL /= 9 THEN
+ FAILED ("INCORRECT GLOBAL VALUE AFTER PROC3");
+ ELSE
+ PROC4; -- CALL AT1(1).E
+ END IF;
+
+ GLOBAL := 10;
+ PROC5(ART2); -- CALL ART2(1).TT.E
+ IF GLOBAL /= 9 THEN
+ FAILED ("INCORRECT GLOBAL VALUE AFTER PROC5");
+ ELSE
+ PROC6; -- CALL ART1(1).TT.E
+ END IF;
+
+-- MAKE SURE ALL TASKS TERMINATED
+ TERM (RT1.TT, '1');
+ TERM (RT2.TT, '2');
+ TERM (RRT1.RR.TT, '3');
+ TERM (RRT2.RR.TT, '4');
+ TERM (AT1(1), '5');
+ TERM (AT2(1), '6');
+ TERM (AT1(2), '7');
+ TERM (AT2(2), '8');
+ TERM (ART1(1).TT, '9');
+ TERM (ART2(1).TT, 'A');
+ TERM (ART1(2).TT, 'B');
+ TERM (ART2(2).TT, 'C');
+
+ RESULT;
+
+END C64201C;