URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95087a.ada] - Blame information for rev 720

Details | Compare with Previous | View Log


-- C95087A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
--   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
--   SUBTESTS ARE:
--        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
--        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
--        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
--        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
 
-- GLH  7/19/85
-- JRK 8/23/85
 
WITH REPORT; USE REPORT;
PROCEDURE C95087A IS
 
BEGIN
     TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
                      "UNCONSTRAINED FORMAL PARAMETERS");
 
     DECLARE  -- (A)
 
          PACKAGE PKG IS
 
              SUBTYPE INT IS INTEGER RANGE 0..100;
 
              TYPE RECTYPE (CONSTRAINT : INT := 80) IS
                    RECORD
                         INTFIELD : INTEGER;
                         STRFIELD : STRING (1..CONSTRAINT);
                    END RECORD;
 
               REC1 : RECTYPE := (10,10,"0123456789");
               REC2 : RECTYPE := (17,7,"C95087A..........");
               REC3 : RECTYPE := (1,1,"A");
               REC4 : RECTYPE;  -- 80.
 
               TASK T1 IS
                    ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
                              REC2 : OUT RECTYPE;
                              REC3 : IN OUT RECTYPE);
               END T1;
 
               TASK T2 IS
                    ENTRY E2 (REC : OUT RECTYPE);
               END T2;
          END PKG;
 
          PACKAGE BODY PKG IS
 
               TASK BODY T1 IS
               BEGIN
                    ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
                               REC2 : OUT RECTYPE;
                               REC3 : IN OUT RECTYPE) DO
 
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
                              FAILED ("RECORD TYPE IN PARAMETER " &
                                      "DID NOT USE CONSTRAINT " &
                                      "OF ACTUAL");
                         END IF;
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
                              FAILED ("RECORD TYPE OUT " &
                                      "PARAMETER DID NOT USE " &
                                      "CONSTRAINT OF ACTUAL");
                         END IF;
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
                              FAILED ("RECORD TYPE IN OUT " &
                                      "PARAMETER DID NOT USE " &
                                      "CONSTRAINT OF ACTUAL");
                         END IF;
                         REC2 := PKG.REC2;
                    END E1;
               END T1;
 
               TASK BODY T2 IS
               BEGIN
                    ACCEPT E2 (REC : OUT RECTYPE) DO
                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
                              FAILED ("RECORD TYPE OUT " &
                                      "PARAMETER DID " &
                                      "NOT USE CONSTRAINT OF " &
                                      "UNINITIALIZED ACTUAL");
                         END IF;
                         REC := (10,10,"9876543210");
                    END E2;
               END T2;
          END PKG;
 
     BEGIN  -- (A)
 
          PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
          PKG.T2.E2 (PKG.REC4);
 
     END;   -- (A)
 
     ---------------------------------------------
 
B :  DECLARE  -- (B)
 
          PACKAGE PKG IS
 
               SUBTYPE INT IS INTEGER RANGE 0..100;
 
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
 
 
               TASK T1 IS
                    ENTRY E1 (REC1 : IN RECTYPE;
                              REC2 : OUT RECTYPE;
                              REC3 : IN OUT RECTYPE);
               END T1;
 
               TASK T2 IS
                    ENTRY E2  (REC : OUT RECTYPE);
               END T2;
 
          PRIVATE
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
                    RECORD
                         INTFIELD : INTEGER;
                         STRFIELD : STRING (1..CONSTRAINT);
                    END RECORD;
          END PKG;
 
          REC1 : PKG.RECTYPE (10);
          REC2 : PKG.RECTYPE (17);
          REC3 : PKG.RECTYPE (1);
          REC4 : PKG.RECTYPE (10);
 
          PACKAGE BODY PKG IS
 
               TASK BODY T1 IS
               BEGIN
                    ACCEPT E1 (REC1 : IN RECTYPE;
                               REC2 : OUT RECTYPE;
                               REC3 : IN OUT RECTYPE) DO
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
                              FAILED ("PRIVATE TYPE IN " &
                                      "PARAMETER DID " &
                                      "NOT USE CONSTRAINT OF " &
                                      "ACTUAL");
                         END IF;
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
                              FAILED ("PRIVATE TYPE OUT " &
                                      "PARAMETER DID " &
                                      "NOT USE CONSTRAINT OF " &
                                      "ACTUAL");
                         END IF;
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
                              FAILED ("PRIVATE TYPE IN OUT " &
                                      "PARAMETER DID " &
                                      "NOT USE CONSTRAINT OF " &
                                      "ACTUAL");
                         END IF;
                         REC2 := B.REC2;
                    END E1;
               END T1;
 
               TASK BODY T2 IS
               BEGIN
                    ACCEPT E2 (REC : OUT RECTYPE) DO
                         IF REC.CONSTRAINT /= IDENT_INT (10) THEN
                              FAILED ("PRIVATE TYPE OUT " &
                                      "PARAMETER DID " &
                                      "NOT USE CONSTRAINT OF " &
                                      "UNINITIALIZED ACTUAL");
                         END IF;
                         REC := (10,10,"9876543210");
                    END E2;
               END T2;
 
          BEGIN
               REC1 := (10,10,"0123456789");
               REC2 := (17,7,"C95087A..........");
               REC3 := (1,1,"A");
          END PKG;
 
     BEGIN  -- (B)
 
          PKG.T1.E1 (REC1, REC2, REC3);
          PKG.T2.E2 (REC4);
 
     END B;  -- (B)
 
     ---------------------------------------------
 
C :  DECLARE  -- (C)
 
          PACKAGE PKG IS
 
               SUBTYPE INT IS INTEGER RANGE 0..100;
 
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
                    LIMITED PRIVATE;
 
               TASK T1 IS
                    ENTRY E1 (REC1 : IN RECTYPE;
                              REC2 : OUT RECTYPE;
                              REC3 : IN OUT RECTYPE);
               END T1;
 
               TASK T2 IS
                    ENTRY E2 (REC : OUT RECTYPE);
               END T2;
 
          PRIVATE
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
                    RECORD
                         INTFIELD : INTEGER;
                         STRFIELD : STRING (1..CONSTRAINT);
                    END RECORD;
          END PKG;
 
          REC1 : PKG.RECTYPE;     -- 10.
          REC2 : PKG.RECTYPE;     -- 17.
          REC3 : PKG.RECTYPE;     --  1.
          REC4 : PKG.RECTYPE;     -- 80.
 
          PACKAGE BODY PKG IS
 
               TASK BODY T1 IS
               BEGIN
                    ACCEPT E1 (REC1 : IN RECTYPE;
                               REC2 : OUT RECTYPE;
                               REC3 : IN OUT RECTYPE) DO
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
                              FAILED ("LIMITED PRIVATE TYPE IN " &
                                      "PARAMETER DID NOT USE " &
                                      "CONSTRAINT OF ACTUAL");
                         END IF;
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
                              FAILED ("LIMITED PRIVATE TYPE OUT " &
                                      "PARAMETER DID NOT USE " &
                                      "CONSTRAINT OF " &
                                      "ACTUAL");
                         END IF;
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
                              FAILED ("LIMITED PRIVATE TYPE IN " &
                                      "OUT PARAMETER DID NOT " &
                                      "USE CONSTRAINT OF ACTUAL");
                         END IF;
                         REC2 := C.REC2;
                    END E1;
               END T1;
 
               TASK BODY T2 IS
               BEGIN
                    ACCEPT E2 (REC : OUT RECTYPE) DO
                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
                              FAILED ("LIMITED PRIVATE TYPE OUT " &
                                      "PARAMETER DID NOT USE " &
                                      "CONSTRAINT OF UNINITIALIZED " &
                                      "ACTUAL");
                         END IF;
                         REC := (10,10,"9876543210");
                    END E2;
               END T2;
 
          BEGIN
               REC1 := (10,10,"0123456789");
               REC2 := (17,7,"C95087A..........");
               REC3 := (1,1,"A");
          END PKG;
 
     BEGIN  -- (C)
 
          PKG.T1.E1 (REC1, REC2, REC3);
          PKG.T2.E2 (REC4);
 
     END C;   -- (C)
 
     ---------------------------------------------
 
D :  DECLARE  -- (D)
 
          TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
               CHARACTER;
 
          A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
                                               ('C','D'),
                                               ('E','F'));
 
          A4  : ATYPE (-1..1, 4..5);
 
          CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
                               (8..9 => (-7..INTEGER'FIRST => 'A'));
 
          S1  : STRING (1..INTEGER'FIRST) := "";
          S2  : STRING (-5..-7)           := "";
          S3  : STRING (1..0)             := "";
 
          TASK T1 IS
               ENTRY E1 (A1 : IN ATYPE := CA1;
                         A2 : OUT ATYPE;
                         A3 : IN OUT ATYPE);
          END T1;
 
          TASK T2 IS
               ENTRY E2 (A4 : OUT ATYPE);
          END T2;
 
          TASK T3 IS
               ENTRY E3 (S1 : IN STRING;
                         S2 : IN OUT STRING;
                         S3 : OUT STRING);
          END T3;
 
          TASK BODY T1 IS
          BEGIN
               ACCEPT E1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
                          A3 : IN OUT ATYPE) DO
                    IF A1'FIRST(1) /= IDENT_INT (-1) OR
                       A1'LAST(1)  /= IDENT_INT (1)  OR
                       A1'FIRST(2) /= IDENT_INT (4)  OR
                       A1'LAST(2)  /= IDENT_INT (5)  THEN
                         FAILED ("ARRAY TYPE IN PARAMETER DID " &
                                 "NOT USE CONSTRAINTS OF ACTUAL");
                    END IF;
                    IF A2'FIRST(1) /= IDENT_INT (-1) OR
                       A2'LAST(1)  /= IDENT_INT (1)  OR
                       A2'FIRST(2) /= IDENT_INT (4)  OR
                       A2'LAST(2)  /= IDENT_INT (5)  THEN
                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
                                 "NOT USE CONSTRAINTS OF ACTUAL");
                    END IF;
                    IF A3'FIRST(1) /= IDENT_INT (-1) OR
                       A3'LAST(1)  /= IDENT_INT (1)  OR
                       A3'FIRST(2) /= IDENT_INT (4)  OR
                       A3'LAST(2)  /= IDENT_INT (5)  THEN
                         FAILED ("ARRAY TYPE IN OUT PARAMETER " &
                                 "DID NOT USE CONSTRAINTS OF " &
                                 "ACTUAL");
                    END IF;
                    A2 := D.A2;
               END E1;
          END T1;
 
          TASK BODY T2 IS
          BEGIN
               ACCEPT E2 (A4 : OUT ATYPE) DO
                    IF A4'FIRST(1) /= IDENT_INT (-1) OR
                       A4'LAST(1)  /= IDENT_INT (1)  OR
                       A4'FIRST(2) /= IDENT_INT (4)  OR
                       A4'LAST(2)  /= IDENT_INT (5)  THEN
                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
                                 "NOT USE CONSTRAINTS OF " &
                                 "UNINITIALIZED ACTUAL");
                    END IF;
                    A4 := A2;
               END E2;
          END T2;
 
          TASK BODY T3 IS
          BEGIN
               ACCEPT E3 (S1 : IN STRING;
                          S2 : IN OUT STRING;
                          S3 : OUT STRING) DO
                    IF S1'FIRST /= IDENT_INT (1) OR
                       S1'LAST  /= IDENT_INT (INTEGER'FIRST) THEN
                         FAILED ("STRING TYPE IN PARAMETER DID " &
                                 "NOT USE CONSTRAINTS OF ACTUAL " &
                                 "NULL STRING");
                    END IF;
                    IF S2'FIRST /= IDENT_INT (-5) OR
                       S2'LAST  /= IDENT_INT (-7) THEN
                         FAILED ("STRING TYPE IN OUT PARAMETER " &
                                 "DID NOT USE CONSTRAINTS OF " &
                                 "ACTUAL NULL STRING");
                    END IF;
                    IF S3'FIRST /= IDENT_INT (1) OR
                       S3'LAST  /= IDENT_INT (0) THEN
                         FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
                                 "USE CONSTRAINTS OF ACTUAL NULL " &
                                 "STRING");
                    END IF;
                    S3 := "";
               END E3;
          END T3;
 
     BEGIN  -- (D)
 
          T1.E1 (A1, A2, A3);
          T2.E2 (A4);
          T3.E3 (S1, S2, S3);
 
     END D;  -- (D)
 
     RESULT;
END C95087A;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95087a.ada] - Blame information for rev 720

Line No.	Rev	Author	Line
1	720	jeremybenn	`-- C95087A.ADA`
2
3			`-- Grant of Unlimited Rights`
4			`--`
5			`-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,`
6			`-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained`
7			`-- unlimited rights in the software and documentation contained herein.`
8			`-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making`
9			`-- this public release, the Government intends to confer upon all`
10			`-- recipients unlimited rights equal to those held by the Government.`
11			`-- These rights include rights to use, duplicate, release or disclose the`
12			`-- released technical data and computer software in whole or in part, in`
13			`-- any manner and for any purpose whatsoever, and to have or permit others`
14			`-- to do so.`
15			`--`
16			`-- DISCLAIMER`
17			`--`
18			`-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR`
19			`-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED`
20			`-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE`
21			`-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE`
22			`-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A`
23			`-- PARTICULAR PURPOSE OF SAID MATERIAL.`
24			`--*`
25			`-- CHECK THAT UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY`
26			`-- FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.`
27			`-- SUBTESTS ARE:`
28			`-- (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.`
29			`-- (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.`
30			`-- (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.`
31			`-- (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.`
32
33			`-- GLH 7/19/85`
34			`-- JRK 8/23/85`
35
36			`WITH REPORT; USE REPORT;`
37			`PROCEDURE C95087A IS`
38
39			`BEGIN`
40			`TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &`
41			`"UNCONSTRAINED FORMAL PARAMETERS");`
42
43			`DECLARE -- (A)`
44
45			`PACKAGE PKG IS`
46
47			`SUBTYPE INT IS INTEGER RANGE 0..100;`
48
49			`TYPE RECTYPE (CONSTRAINT : INT := 80) IS`
50			`RECORD`
51			`INTFIELD : INTEGER;`
52			`STRFIELD : STRING (1..CONSTRAINT);`
53			`END RECORD;`
54
55			`REC1 : RECTYPE := (10,10,"0123456789");`
56			`REC2 : RECTYPE := (17,7,"C95087A..........");`
57			`REC3 : RECTYPE := (1,1,"A");`
58			`REC4 : RECTYPE; -- 80.`
59
60			`TASK T1 IS`
61			`ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");`
62			`REC2 : OUT RECTYPE;`
63			`REC3 : IN OUT RECTYPE);`
64			`END T1;`
65
66			`TASK T2 IS`
67			`ENTRY E2 (REC : OUT RECTYPE);`
68			`END T2;`
69			`END PKG;`
70
71			`PACKAGE BODY PKG IS`
72
73			`TASK BODY T1 IS`
74			`BEGIN`
75			`ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");`
76			`REC2 : OUT RECTYPE;`
77			`REC3 : IN OUT RECTYPE) DO`
78
79			`IF REC1.CONSTRAINT /= IDENT_INT (10) THEN`
80			`FAILED ("RECORD TYPE IN PARAMETER " &`
81			`"DID NOT USE CONSTRAINT " &`
82			`"OF ACTUAL");`
83			`END IF;`
84			`IF REC2.CONSTRAINT /= IDENT_INT (17) THEN`
85			`FAILED ("RECORD TYPE OUT " &`
86			`"PARAMETER DID NOT USE " &`
87			`"CONSTRAINT OF ACTUAL");`
88			`END IF;`
89			`IF REC3.CONSTRAINT /= IDENT_INT (1) THEN`
90			`FAILED ("RECORD TYPE IN OUT " &`
91			`"PARAMETER DID NOT USE " &`
92			`"CONSTRAINT OF ACTUAL");`
93			`END IF;`
94			`REC2 := PKG.REC2;`
95			`END E1;`
96			`END T1;`
97
98			`TASK BODY T2 IS`
99			`BEGIN`
100			`ACCEPT E2 (REC : OUT RECTYPE) DO`
101			`IF REC.CONSTRAINT /= IDENT_INT (80) THEN`
102			`FAILED ("RECORD TYPE OUT " &`
103			`"PARAMETER DID " &`
104			`"NOT USE CONSTRAINT OF " &`
105			`"UNINITIALIZED ACTUAL");`
106			`END IF;`
107			`REC := (10,10,"9876543210");`
108			`END E2;`
109			`END T2;`
110			`END PKG;`
111
112			`BEGIN -- (A)`
113
114			`PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);`
115			`PKG.T2.E2 (PKG.REC4);`
116
117			`END; -- (A)`
118
119			`---------------------------------------------`
120
121			`B : DECLARE -- (B)`
122
123			`PACKAGE PKG IS`
124
125			`SUBTYPE INT IS INTEGER RANGE 0..100;`
126
127			`TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;`
128
129
130			`TASK T1 IS`
131			`ENTRY E1 (REC1 : IN RECTYPE;`
132			`REC2 : OUT RECTYPE;`
133			`REC3 : IN OUT RECTYPE);`
134			`END T1;`
135
136			`TASK T2 IS`
137			`ENTRY E2 (REC : OUT RECTYPE);`
138			`END T2;`
139
140			`PRIVATE`
141			`TYPE RECTYPE (CONSTRAINT : INT := 80) IS`
142			`RECORD`
143			`INTFIELD : INTEGER;`
144			`STRFIELD : STRING (1..CONSTRAINT);`
145			`END RECORD;`
146			`END PKG;`
147
148			`REC1 : PKG.RECTYPE (10);`
149			`REC2 : PKG.RECTYPE (17);`
150			`REC3 : PKG.RECTYPE (1);`
151			`REC4 : PKG.RECTYPE (10);`
152
153			`PACKAGE BODY PKG IS`
154
155			`TASK BODY T1 IS`
156			`BEGIN`
157			`ACCEPT E1 (REC1 : IN RECTYPE;`
158			`REC2 : OUT RECTYPE;`
159			`REC3 : IN OUT RECTYPE) DO`
160			`IF REC1.CONSTRAINT /= IDENT_INT (10) THEN`
161			`FAILED ("PRIVATE TYPE IN " &`
162			`"PARAMETER DID " &`
163			`"NOT USE CONSTRAINT OF " &`
164			`"ACTUAL");`
165			`END IF;`
166			`IF REC2.CONSTRAINT /= IDENT_INT (17) THEN`
167			`FAILED ("PRIVATE TYPE OUT " &`
168			`"PARAMETER DID " &`
169			`"NOT USE CONSTRAINT OF " &`
170			`"ACTUAL");`
171			`END IF;`
172			`IF REC3.CONSTRAINT /= IDENT_INT (1) THEN`
173			`FAILED ("PRIVATE TYPE IN OUT " &`
174			`"PARAMETER DID " &`
175			`"NOT USE CONSTRAINT OF " &`
176			`"ACTUAL");`
177			`END IF;`
178			`REC2 := B.REC2;`
179			`END E1;`
180			`END T1;`
181
182			`TASK BODY T2 IS`
183			`BEGIN`
184			`ACCEPT E2 (REC : OUT RECTYPE) DO`
185			`IF REC.CONSTRAINT /= IDENT_INT (10) THEN`
186			`FAILED ("PRIVATE TYPE OUT " &`
187			`"PARAMETER DID " &`
188			`"NOT USE CONSTRAINT OF " &`
189			`"UNINITIALIZED ACTUAL");`
190			`END IF;`
191			`REC := (10,10,"9876543210");`
192			`END E2;`
193			`END T2;`
194
195			`BEGIN`
196			`REC1 := (10,10,"0123456789");`
197			`REC2 := (17,7,"C95087A..........");`
198			`REC3 := (1,1,"A");`
199			`END PKG;`
200
201			`BEGIN -- (B)`
202
203			`PKG.T1.E1 (REC1, REC2, REC3);`
204			`PKG.T2.E2 (REC4);`
205
206			`END B; -- (B)`
207
208			`---------------------------------------------`
209
210			`C : DECLARE -- (C)`
211
212			`PACKAGE PKG IS`
213
214			`SUBTYPE INT IS INTEGER RANGE 0..100;`
215
216			`TYPE RECTYPE (CONSTRAINT : INT := 80) IS`
217			`LIMITED PRIVATE;`
218
219			`TASK T1 IS`
220			`ENTRY E1 (REC1 : IN RECTYPE;`
221			`REC2 : OUT RECTYPE;`
222			`REC3 : IN OUT RECTYPE);`
223			`END T1;`
224
225			`TASK T2 IS`
226			`ENTRY E2 (REC : OUT RECTYPE);`
227			`END T2;`
228
229			`PRIVATE`
230			`TYPE RECTYPE (CONSTRAINT : INT := 80) IS`
231			`RECORD`
232			`INTFIELD : INTEGER;`
233			`STRFIELD : STRING (1..CONSTRAINT);`
234			`END RECORD;`
235			`END PKG;`
236
237			`REC1 : PKG.RECTYPE; -- 10.`
238			`REC2 : PKG.RECTYPE; -- 17.`
239			`REC3 : PKG.RECTYPE; -- 1.`
240			`REC4 : PKG.RECTYPE; -- 80.`
241
242			`PACKAGE BODY PKG IS`
243
244			`TASK BODY T1 IS`
245			`BEGIN`
246			`ACCEPT E1 (REC1 : IN RECTYPE;`
247			`REC2 : OUT RECTYPE;`
248			`REC3 : IN OUT RECTYPE) DO`
249			`IF REC1.CONSTRAINT /= IDENT_INT (10) THEN`
250			`FAILED ("LIMITED PRIVATE TYPE IN " &`
251			`"PARAMETER DID NOT USE " &`
252			`"CONSTRAINT OF ACTUAL");`
253			`END IF;`
254			`IF REC2.CONSTRAINT /= IDENT_INT (17) THEN`
255			`FAILED ("LIMITED PRIVATE TYPE OUT " &`
256			`"PARAMETER DID NOT USE " &`
257			`"CONSTRAINT OF " &`
258			`"ACTUAL");`
259			`END IF;`
260			`IF REC3.CONSTRAINT /= IDENT_INT (1) THEN`
261			`FAILED ("LIMITED PRIVATE TYPE IN " &`
262			`"OUT PARAMETER DID NOT " &`
263			`"USE CONSTRAINT OF ACTUAL");`
264			`END IF;`
265			`REC2 := C.REC2;`
266			`END E1;`
267			`END T1;`
268
269			`TASK BODY T2 IS`
270			`BEGIN`
271			`ACCEPT E2 (REC : OUT RECTYPE) DO`
272			`IF REC.CONSTRAINT /= IDENT_INT (80) THEN`
273			`FAILED ("LIMITED PRIVATE TYPE OUT " &`
274			`"PARAMETER DID NOT USE " &`
275			`"CONSTRAINT OF UNINITIALIZED " &`
276			`"ACTUAL");`
277			`END IF;`
278			`REC := (10,10,"9876543210");`
279			`END E2;`
280			`END T2;`
281
282			`BEGIN`
283			`REC1 := (10,10,"0123456789");`
284			`REC2 := (17,7,"C95087A..........");`
285			`REC3 := (1,1,"A");`
286			`END PKG;`
287
288			`BEGIN -- (C)`
289
290			`PKG.T1.E1 (REC1, REC2, REC3);`
291			`PKG.T2.E2 (REC4);`
292
293			`END C; -- (C)`
294
295			`---------------------------------------------`
296
297			`D : DECLARE -- (D)`
298
299			`TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF`
300			`CHARACTER;`
301
302			`A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),`
303			`('C','D'),`
304			`('E','F'));`
305
306			`A4 : ATYPE (-1..1, 4..5);`
307
308			`CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=`
309			`(8..9 => (-7..INTEGER'FIRST => 'A'));`
310
311			`S1 : STRING (1..INTEGER'FIRST) := "";`
312			`S2 : STRING (-5..-7) := "";`
313			`S3 : STRING (1..0) := "";`
314
315			`TASK T1 IS`
316			`ENTRY E1 (A1 : IN ATYPE := CA1;`
317			`A2 : OUT ATYPE;`
318			`A3 : IN OUT ATYPE);`
319			`END T1;`
320
321			`TASK T2 IS`
322			`ENTRY E2 (A4 : OUT ATYPE);`
323			`END T2;`
324
325			`TASK T3 IS`
326			`ENTRY E3 (S1 : IN STRING;`
327			`S2 : IN OUT STRING;`
328			`S3 : OUT STRING);`
329			`END T3;`
330
331			`TASK BODY T1 IS`
332			`BEGIN`
333			`ACCEPT E1 (A1 : IN ATYPE := CA1; A2 : OUT ATYPE;`
334			`A3 : IN OUT ATYPE) DO`
335			`IF A1'FIRST(1) /= IDENT_INT (-1) OR`
336			`A1'LAST(1) /= IDENT_INT (1) OR`
337			`A1'FIRST(2) /= IDENT_INT (4) OR`
338			`A1'LAST(2) /= IDENT_INT (5) THEN`
339			`FAILED ("ARRAY TYPE IN PARAMETER DID " &`
340			`"NOT USE CONSTRAINTS OF ACTUAL");`
341			`END IF;`
342			`IF A2'FIRST(1) /= IDENT_INT (-1) OR`
343			`A2'LAST(1) /= IDENT_INT (1) OR`
344			`A2'FIRST(2) /= IDENT_INT (4) OR`
345			`A2'LAST(2) /= IDENT_INT (5) THEN`
346			`FAILED ("ARRAY TYPE OUT PARAMETER DID " &`
347			`"NOT USE CONSTRAINTS OF ACTUAL");`
348			`END IF;`
349			`IF A3'FIRST(1) /= IDENT_INT (-1) OR`
350			`A3'LAST(1) /= IDENT_INT (1) OR`
351			`A3'FIRST(2) /= IDENT_INT (4) OR`
352			`A3'LAST(2) /= IDENT_INT (5) THEN`
353			`FAILED ("ARRAY TYPE IN OUT PARAMETER " &`
354			`"DID NOT USE CONSTRAINTS OF " &`
355			`"ACTUAL");`
356			`END IF;`
357			`A2 := D.A2;`
358			`END E1;`
359			`END T1;`
360
361			`TASK BODY T2 IS`
362			`BEGIN`
363			`ACCEPT E2 (A4 : OUT ATYPE) DO`
364			`IF A4'FIRST(1) /= IDENT_INT (-1) OR`
365			`A4'LAST(1) /= IDENT_INT (1) OR`
366			`A4'FIRST(2) /= IDENT_INT (4) OR`
367			`A4'LAST(2) /= IDENT_INT (5) THEN`
368			`FAILED ("ARRAY TYPE OUT PARAMETER DID " &`
369			`"NOT USE CONSTRAINTS OF " &`
370			`"UNINITIALIZED ACTUAL");`
371			`END IF;`
372			`A4 := A2;`
373			`END E2;`
374			`END T2;`
375
376			`TASK BODY T3 IS`
377			`BEGIN`
378			`ACCEPT E3 (S1 : IN STRING;`
379			`S2 : IN OUT STRING;`
380			`S3 : OUT STRING) DO`
381			`IF S1'FIRST /= IDENT_INT (1) OR`
382			`S1'LAST /= IDENT_INT (INTEGER'FIRST) THEN`
383			`FAILED ("STRING TYPE IN PARAMETER DID " &`
384			`"NOT USE CONSTRAINTS OF ACTUAL " &`
385			`"NULL STRING");`
386			`END IF;`
387			`IF S2'FIRST /= IDENT_INT (-5) OR`
388			`S2'LAST /= IDENT_INT (-7) THEN`
389			`FAILED ("STRING TYPE IN OUT PARAMETER " &`
390			`"DID NOT USE CONSTRAINTS OF " &`
391			`"ACTUAL NULL STRING");`
392			`END IF;`
393			`IF S3'FIRST /= IDENT_INT (1) OR`
394			`S3'LAST /= IDENT_INT (0) THEN`
395			`FAILED ("STRING TYPE OUT PARAMETER DID NOT " &`
396			`"USE CONSTRAINTS OF ACTUAL NULL " &`
397			`"STRING");`
398			`END IF;`
399			`S3 := "";`
400			`END E3;`
401			`END T3;`
402
403			`BEGIN -- (D)`
404
405			`T1.E1 (A1, A2, A3);`
406			`T2.E2 (A4);`
407			`T3.E3 (S1, S2, S3);`
408
409			`END D; -- (D)`
410
411			`RESULT;`
412			`END C95087A;`