|
111
|
1 -- C95085B.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 CONSTRAINT_ERROR IS RAISED UNDER APPROPRIATE CIRCUMSTANCES
|
|
|
26 -- WITH RESPECT TO PARAMETERS OF RECORD TYPES IN ENTRY CALLS. SUBTESTS
|
|
|
27 -- INVOLVE ACTUAL RECORD PARAMETERS WHOSE CONSTRAINT VALUES ARE NOT
|
|
|
28 -- EQUAL TO THE CONSTRAINTS ON THEIR CORRESPONDING FORMAL PARAMETERS:
|
|
|
29 -- (A) IN PARAMETER, STATIC AGGREGATE.
|
|
|
30 -- (B) IN PARAMETER, DYNAMIC AGGREGATE.
|
|
|
31 -- (C) IN PARAMETER, VARIABLE.
|
|
|
32 -- (D) IN OUT PARAMETER, EXCEPTION RAISED ON CALL.
|
|
|
33 -- (E) OUT PARAMETER, EXCEPTION RAISED ON CALL.
|
|
|
34
|
|
|
35 -- JWC 10/25/85
|
|
|
36
|
|
|
37 WITH REPORT; USE REPORT;
|
|
|
38 PROCEDURE C95085B IS
|
|
|
39
|
|
|
40 SUBTYPE INT IS INTEGER RANGE 0..10;
|
|
|
41
|
|
|
42 TYPE REC (N : INT := 0) IS
|
|
|
43 RECORD
|
|
|
44 A : STRING (1..N);
|
|
|
45 END RECORD;
|
|
|
46
|
|
|
47 SUBTYPE SREC IS REC(N=>3);
|
|
|
48
|
|
|
49 BEGIN
|
|
|
50
|
|
|
51 TEST ("C95085B", "CHECK RAISING OF CONSTRAINT_ERROR FOR " &
|
|
|
52 "PARAMETERS OF RECORD TYPES");
|
|
|
53
|
|
|
54 DECLARE
|
|
|
55
|
|
|
56 TASK TSK1 IS
|
|
|
57 ENTRY E (R : IN SREC);
|
|
|
58 END TSK1;
|
|
|
59
|
|
|
60 TASK BODY TSK1 IS
|
|
|
61 BEGIN
|
|
|
62 LOOP
|
|
|
63 BEGIN
|
|
|
64 SELECT
|
|
|
65 ACCEPT E (R : IN SREC) DO
|
|
|
66 FAILED ("EXCEPTION NOT RAISED ON " &
|
|
|
67 "CALL TO TSK1");
|
|
|
68 END E;
|
|
|
69 OR
|
|
|
70 TERMINATE;
|
|
|
71 END SELECT;
|
|
|
72 EXCEPTION
|
|
|
73 WHEN OTHERS =>
|
|
|
74 FAILED ("EXCEPTION RAISED IN TSK1");
|
|
|
75 END;
|
|
|
76 END LOOP;
|
|
|
77 END TSK1;
|
|
|
78
|
|
|
79 BEGIN
|
|
|
80
|
|
|
81 BEGIN -- (A)
|
|
|
82 TSK1.E ((2,"AA"));
|
|
|
83 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (A)");
|
|
|
84 EXCEPTION
|
|
|
85 WHEN CONSTRAINT_ERROR =>
|
|
|
86 NULL;
|
|
|
87 WHEN OTHERS =>
|
|
|
88 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (A)");
|
|
|
89 END; -- (A)
|
|
|
90
|
|
|
91 BEGIN -- (B)
|
|
|
92 TSK1.E ((IDENT_INT(2), "AA"));
|
|
|
93 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (B)");
|
|
|
94 EXCEPTION
|
|
|
95 WHEN CONSTRAINT_ERROR =>
|
|
|
96 NULL;
|
|
|
97 WHEN OTHERS =>
|
|
|
98 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (B)");
|
|
|
99 END; -- (B)
|
|
|
100
|
|
|
101 DECLARE -- (C)
|
|
|
102 R : REC := (IDENT_INT(2), "AA");
|
|
|
103 BEGIN -- (C)
|
|
|
104 TSK1.E (R);
|
|
|
105 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (C)");
|
|
|
106 EXCEPTION
|
|
|
107 WHEN CONSTRAINT_ERROR =>
|
|
|
108 NULL;
|
|
|
109 WHEN OTHERS =>
|
|
|
110 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (C)");
|
|
|
111 END; -- (C)
|
|
|
112
|
|
|
113 END;
|
|
|
114
|
|
|
115 DECLARE -- (D)
|
|
|
116
|
|
|
117 R : REC := (IDENT_INT(2), "AA");
|
|
|
118
|
|
|
119 TASK TSK2 IS
|
|
|
120 ENTRY E (R : IN OUT SREC);
|
|
|
121 END TSK2;
|
|
|
122
|
|
|
123 TASK BODY TSK2 IS
|
|
|
124 BEGIN
|
|
|
125 SELECT
|
|
|
126 ACCEPT E (R : IN OUT SREC) DO
|
|
|
127 FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
|
|
|
128 "TSK2");
|
|
|
129 END E;
|
|
|
130 OR
|
|
|
131 TERMINATE;
|
|
|
132 END SELECT;
|
|
|
133 EXCEPTION
|
|
|
134 WHEN OTHERS =>
|
|
|
135 FAILED ("EXCEPTION RAISED IN TSK2");
|
|
|
136 END TSK2;
|
|
|
137
|
|
|
138 BEGIN -- (D)
|
|
|
139 TSK2.E (R);
|
|
|
140 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (D)");
|
|
|
141 EXCEPTION
|
|
|
142 WHEN CONSTRAINT_ERROR =>
|
|
|
143 NULL;
|
|
|
144 WHEN OTHERS =>
|
|
|
145 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (D)");
|
|
|
146 END; -- (D)
|
|
|
147
|
|
|
148 DECLARE -- (E)
|
|
|
149
|
|
|
150 R : REC;
|
|
|
151
|
|
|
152 TASK TSK3 IS
|
|
|
153 ENTRY E (R : OUT SREC);
|
|
|
154 END TSK3;
|
|
|
155
|
|
|
156 TASK BODY TSK3 IS
|
|
|
157 BEGIN
|
|
|
158 SELECT
|
|
|
159 ACCEPT E (R : OUT SREC) DO
|
|
|
160 FAILED ("EXCEPTION NOT RAISED ON CALL TO " &
|
|
|
161 "TSK3");
|
|
|
162 END E;
|
|
|
163 OR
|
|
|
164 TERMINATE;
|
|
|
165 END SELECT;
|
|
|
166 EXCEPTION
|
|
|
167 WHEN OTHERS =>
|
|
|
168 FAILED ("EXCEPTION RAISED IN TSK3");
|
|
|
169 END TSK3;
|
|
|
170
|
|
|
171 BEGIN -- (E)
|
|
|
172 TSK3.E (R);
|
|
|
173 FAILED ("EXCEPTION NOT RAISED IN SUBTEST (E)");
|
|
|
174 EXCEPTION
|
|
|
175 WHEN CONSTRAINT_ERROR =>
|
|
|
176 NULL;
|
|
|
177 WHEN OTHERS =>
|
|
|
178 FAILED ("WRONG EXCEPTION RAISED IN SUBTEST (E)");
|
|
|
179 END; -- (E)
|
|
|
180
|
|
|
181 RESULT;
|
|
|
182
|
|
|
183 END C95085B;
|
