aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada')
-rw-r--r--gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada302
1 files changed, 302 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
new file mode 100644
index 000000000..d4393d51d
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/ada/acats/tests/c9/c95067a.ada
@@ -0,0 +1,302 @@
+-- C95067A.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 A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
+-- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
+
+-- JWC 6/20/85
+
+WITH REPORT; USE REPORT;
+PROCEDURE C95067A IS
+
+ PACKAGE PKG IS
+
+ TYPE ITYPE IS LIMITED PRIVATE;
+
+ TASK T1 IS
+
+ ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+
+ ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
+ M : STRING);
+
+ ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
+
+ END T1;
+
+ SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
+ TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
+
+ TASK T2 IS
+
+ ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+ I : INTEGER; S : STRING; M : STRING);
+
+ ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
+ I : INTEGER; S : STRING;
+ M : STRING);
+
+ ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+ I : INTEGER; S : STRING);
+
+ END T2;
+
+ PRIVATE
+
+ TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
+
+ TYPE VRTYPE (C : INT_0_20 := 20) IS
+ RECORD
+ I : INTEGER;
+ S : STRING (1 .. C);
+ END RECORD;
+
+ END PKG;
+
+ USE PKG;
+
+ I1 : ITYPE;
+
+ TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
+
+ A1 : ATYPE;
+
+ VR1 : VRTYPE;
+
+ D : CONSTANT INT_0_20 := 10;
+
+ TYPE RTYPE IS
+ RECORD
+ J : ITYPE;
+ R : VRTYPE (D);
+ END RECORD;
+
+ R1 : RTYPE;
+
+ PACKAGE BODY PKG IS
+
+ TASK BODY T1 IS
+ BEGIN
+ LOOP
+ SELECT
+ ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
+ M : STRING) DO
+ IF INTEGER (X) /= V THEN
+ FAILED ("WRONG SCALAR VALUE - " & M);
+ END IF;
+ END LOOK_IN_I;
+ OR
+ ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
+ V : INTEGER;
+ M : STRING) DO
+ IF INTEGER (X) /= V THEN
+ FAILED ("WRONG SCALAR VALUE - " & M);
+ END IF;
+ END LOOK_INOUT_I;
+ OR
+ ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
+ X := ITYPE (IDENT_INT (V));
+ END SET_I;
+ OR
+ TERMINATE;
+ END SELECT;
+ END LOOP;
+ END T1;
+
+ TASK BODY T2 IS
+ BEGIN
+ LOOP
+ SELECT
+ ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
+ I : INTEGER; S : STRING;
+ M : STRING) DO
+ IF (X.C /= C OR X.I /= I) OR ELSE
+ X.S /= S THEN
+ FAILED ("WRONG COMPOSITE VALUE - " &
+ M);
+ END IF;
+ END LOOK_IN_VR;
+ OR
+ ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
+ C : INTEGER; I : INTEGER;
+ S : STRING;
+ M : STRING) DO
+ IF (X.C /= C OR X.I /= I) OR ELSE
+ X.S /= S THEN
+ FAILED ("WRONG COMPOSITE VALUE - " &
+ M);
+ END IF;
+ END LOOK_INOUT_VR;
+ OR
+ ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
+ I : INTEGER; S : STRING) DO
+ X := (IDENT_INT(C), IDENT_INT(I),
+ IDENT_STR(S));
+ END SET_VR;
+ OR
+ TERMINATE;
+ END SELECT;
+ END LOOP;
+ END T2;
+
+ BEGIN
+ I1 := ITYPE (IDENT_INT(2));
+
+ FOR I IN A1'RANGE LOOP
+ A1 (I) := ITYPE (3 + IDENT_INT(I));
+ END LOOP;
+
+ VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
+
+ R1.J := ITYPE (IDENT_INT(6));
+ R1.R := (IDENT_INT(D), IDENT_INT(19),
+ IDENT_STR("ABCDEFGHIJ"));
+ END PKG;
+
+ TASK T3 IS
+ ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
+
+ ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+ NV : INTEGER; M : STRING);
+
+ ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
+
+ ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+ NV : INTEGER; M : STRING);
+
+ ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+ S : STRING; M : STRING);
+
+ ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
+ OC : INTEGER; OI : INTEGER; OS : STRING;
+ NC : INTEGER; NI : INTEGER; NS : STRING;
+ M : STRING);
+
+ ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+ I : INTEGER; S : STRING; M : STRING);
+
+ ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+ OC : INTEGER; OI : INTEGER; OS : STRING;
+ NJ : INTEGER;
+ NC : INTEGER; NI : INTEGER; NS : STRING;
+ M : STRING);
+ END T3;
+
+ TASK BODY T3 IS
+ BEGIN
+ ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
+ T1.LOOK_IN_I (X, V, M);
+ END CHECK_IN_I;
+
+ ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
+ NV : INTEGER; M : STRING) DO
+ T1.LOOK_INOUT_I (X, OV, M & " - A");
+ T1.SET_I (X, NV);
+ T1.LOOK_INOUT_I (X, NV, M & " - B");
+ T1.LOOK_IN_I (X, NV, M & " - C");
+ END CHECK_INOUT_I;
+
+ ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
+ FOR I IN X'RANGE LOOP
+ T1.LOOK_IN_I (X(I), V+I, M & " -" &
+ INTEGER'IMAGE (I));
+ END LOOP;
+ END CHECK_IN_A;
+
+ ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
+ NV : INTEGER; M : STRING) DO
+ FOR I IN X'RANGE LOOP
+ T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
+ INTEGER'IMAGE (I));
+ T1.SET_I (X(I), NV+I);
+ T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
+ INTEGER'IMAGE (I));
+ T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
+ INTEGER'IMAGE (I));
+ END LOOP;
+ END CHECK_INOUT_A;
+
+ ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
+ S : STRING; M : STRING) DO
+ T2.LOOK_IN_VR (X, C, I, S, M);
+ END CHECK_IN_VR;
+
+ ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
+ OC : INTEGER; OI : INTEGER;
+ OS : STRING;
+ NC : INTEGER; NI : INTEGER;
+ NS : STRING;
+ M : STRING) DO
+ T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
+ T2.SET_VR (X, NC, NI, NS);
+ T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
+ T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
+ END CHECK_INOUT_VR;
+
+ ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
+ I : INTEGER; S : STRING; M : STRING) DO
+ T1.LOOK_IN_I (X.J, J, M & " - A");
+ T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
+ END CHECK_IN_R;
+
+ ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
+ OC : INTEGER; OI : INTEGER; OS : STRING;
+ NJ : INTEGER;
+ NC : INTEGER; NI : INTEGER; NS : STRING;
+ M : STRING) DO
+ T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
+ T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
+ T1.SET_I (X.J, NJ);
+ T2.SET_VR (X.R, NC, NI, NS);
+ T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
+ T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
+ T1.LOOK_IN_I (X.J, NJ, M & " - E");
+ T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
+ END CHECK_INOUT_R;
+ END T3;
+
+BEGIN
+ TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
+ "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
+
+ T3.CHECK_IN_I (I1, 2, "IN I");
+
+ T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
+
+ T3.CHECK_IN_A (A1, 3, "IN A");
+
+ T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
+
+ T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
+
+ T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
+ "INOUT VR");
+
+ T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
+
+ T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
+ "ZYXWVUTSRQ", "INOUT R");
+
+ RESULT;
+END C95067A;
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-23 12:46:03 +0000