|
111
|
1 -- C95085A.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 FOR OUT OF RANGE SCALAR
|
|
|
26 -- ARGUMENTS. SUBTESTS ARE:
|
|
|
27 -- (A) STATIC IN ARGUMENT.
|
|
|
28 -- (B) DYNAMIC IN ARGUMENT.
|
|
|
29 -- (C) IN OUT, OUT OF RANGE ON CALL.
|
|
|
30 -- (D) OUT, OUT OF RANGE ON RETURN.
|
|
|
31 -- (E) IN OUT, OUT OF RANGE ON RETURN.
|
|
|
32
|
|
|
33 -- GLH 7/15/85
|
|
|
34 -- JRK 8/23/85
|
|
|
35 -- JWC 11/15/85 ADDED VARIABLE "CALLED" TO ENSURE THAT THE ENTRY
|
|
|
36 -- CALL WAS MADE FOR THOSE CASES THAT ARE APPLICABLE.
|
|
|
37
|
|
|
38 WITH REPORT; USE REPORT;
|
|
|
39 PROCEDURE C95085A IS
|
|
|
40
|
|
|
41 SUBTYPE DIGIT IS INTEGER RANGE 0..9;
|
|
|
42
|
|
|
43 D : DIGIT;
|
|
|
44 I : INTEGER;
|
|
|
45 M1 : CONSTANT INTEGER := IDENT_INT (-1);
|
|
|
46 COUNT : INTEGER := 0;
|
|
|
47 CALLED : BOOLEAN;
|
|
|
48
|
|
|
49 SUBTYPE SI IS INTEGER RANGE M1 .. 10;
|
|
|
50
|
|
|
51 TASK T1 IS
|
|
|
52 ENTRY E1 (PIN : IN DIGIT; WHO : STRING); -- (A), (B).
|
|
|
53 END T1;
|
|
|
54
|
|
|
55 TASK BODY T1 IS
|
|
|
56 BEGIN
|
|
|
57 LOOP
|
|
|
58 BEGIN
|
|
|
59 SELECT
|
|
|
60 ACCEPT E1 (PIN : IN DIGIT;
|
|
|
61 WHO : STRING) DO -- (A), (B).
|
|
|
62 FAILED ("EXCEPTION NOT RAISED BEFORE " &
|
|
|
63 "CALL - E1 " & WHO);
|
|
|
64 END E1;
|
|
|
65 OR
|
|
|
66 TERMINATE;
|
|
|
67 END SELECT;
|
|
|
68 EXCEPTION
|
|
|
69 WHEN OTHERS =>
|
|
|
70 FAILED ("EXCEPTION RAISED IN E1");
|
|
|
71 END;
|
|
|
72 END LOOP;
|
|
|
73 END T1;
|
|
|
74
|
|
|
75 TASK T2 IS
|
|
|
76 ENTRY E2 (PINOUT : IN OUT DIGIT; WHO : STRING); -- (C).
|
|
|
77 END T2;
|
|
|
78
|
|
|
79 TASK BODY T2 IS
|
|
|
80 BEGIN
|
|
|
81 LOOP
|
|
|
82 BEGIN
|
|
|
83 SELECT
|
|
|
84 ACCEPT E2 (PINOUT : IN OUT DIGIT;
|
|
|
85 WHO : STRING) DO -- (C).
|
|
|
86 FAILED ("EXCEPTION NOT RAISED BEFORE " &
|
|
|
87 "CALL - E2 " & WHO);
|
|
|
88 END E2;
|
|
|
89 OR
|
|
|
90 TERMINATE;
|
|
|
91 END SELECT;
|
|
|
92 EXCEPTION
|
|
|
93 WHEN OTHERS =>
|
|
|
94 FAILED ("EXCEPTION RAISED IN E2");
|
|
|
95 END;
|
|
|
96 END LOOP;
|
|
|
97 END T2;
|
|
|
98
|
|
|
99 TASK T3 IS
|
|
|
100 ENTRY E3 (POUT : OUT SI; WHO : STRING); -- (D).
|
|
|
101 END T3;
|
|
|
102
|
|
|
103 TASK BODY T3 IS
|
|
|
104 BEGIN
|
|
|
105 LOOP
|
|
|
106 BEGIN
|
|
|
107 SELECT
|
|
|
108 ACCEPT E3 (POUT : OUT SI;
|
|
|
109 WHO : STRING) DO -- (D).
|
|
|
110 CALLED := TRUE;
|
|
|
111 IF WHO = "10" THEN
|
|
|
112 POUT := IDENT_INT (10); -- 10 IS NOT
|
|
|
113 -- A DIGIT.
|
|
|
114 ELSE
|
|
|
115 POUT := -1;
|
|
|
116 END IF;
|
|
|
117 END E3;
|
|
|
118 OR
|
|
|
119 TERMINATE;
|
|
|
120 END SELECT;
|
|
|
121 EXCEPTION
|
|
|
122 WHEN OTHERS =>
|
|
|
123 FAILED ("EXCEPTION RAISED IN E3");
|
|
|
124 END;
|
|
|
125 END LOOP;
|
|
|
126 END T3;
|
|
|
127
|
|
|
128 TASK T4 IS
|
|
|
129 ENTRY E4 (PINOUT : IN OUT INTEGER; WHO : STRING); -- (E).
|
|
|
130 END T4;
|
|
|
131
|
|
|
132 TASK BODY T4 IS
|
|
|
133 BEGIN
|
|
|
134 LOOP
|
|
|
135 BEGIN
|
|
|
136 SELECT
|
|
|
137 ACCEPT E4 (PINOUT : IN OUT INTEGER;
|
|
|
138 WHO : STRING) DO -- (E).
|
|
|
139 CALLED := TRUE;
|
|
|
140 IF WHO = "10" THEN
|
|
|
141 PINOUT := 10; -- 10 IS NOT A DIGIT.
|
|
|
142 ELSE
|
|
|
143 PINOUT := IDENT_INT (-1);
|
|
|
144 END IF;
|
|
|
145 END E4;
|
|
|
146 OR
|
|
|
147 TERMINATE;
|
|
|
148 END SELECT;
|
|
|
149 EXCEPTION
|
|
|
150 WHEN OTHERS =>
|
|
|
151 FAILED ("EXCEPTION RAISED IN E4");
|
|
|
152 END;
|
|
|
153 END LOOP;
|
|
|
154 END T4;
|
|
|
155
|
|
|
156 BEGIN
|
|
|
157
|
|
|
158 TEST ("C95085A", "CHECK THAT CONSTRAINT_ERROR IS RAISED " &
|
|
|
159 "FOR OUT OF RANGE SCALAR ARGUMENTS");
|
|
|
160
|
|
|
161 BEGIN -- (A)
|
|
|
162 T1.E1 (10, "10");
|
|
|
163 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (10)");
|
|
|
164 EXCEPTION
|
|
|
165 WHEN CONSTRAINT_ERROR =>
|
|
|
166 COUNT := COUNT + 1;
|
|
|
167 WHEN OTHERS =>
|
|
|
168 FAILED ("WRONG EXCEPTION RAISED FOR E1 (10)");
|
|
|
169 END; -- (A)
|
|
|
170
|
|
|
171 BEGIN -- (B)
|
|
|
172 T1.E1 (IDENT_INT (-1), "-1");
|
|
|
173 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E1 (" &
|
|
|
174 "IDENT_INT (-1))");
|
|
|
175 EXCEPTION
|
|
|
176 WHEN CONSTRAINT_ERROR =>
|
|
|
177 COUNT := COUNT + 1;
|
|
|
178 WHEN OTHERS =>
|
|
|
179 FAILED ("WRONG EXCEPTION RAISED FOR E1 (" &
|
|
|
180 "IDENT_INT (-1))");
|
|
|
181 END; -- (B)
|
|
|
182
|
|
|
183 BEGIN -- (C)
|
|
|
184 I := IDENT_INT (10);
|
|
|
185 T2.E2 (I, "10");
|
|
|
186 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (10)");
|
|
|
187 EXCEPTION
|
|
|
188 WHEN CONSTRAINT_ERROR =>
|
|
|
189 COUNT := COUNT + 1;
|
|
|
190 WHEN OTHERS =>
|
|
|
191 FAILED ("WRONG EXCEPTION RAISED FOR E2 (10)");
|
|
|
192 END; -- (C)
|
|
|
193
|
|
|
194 BEGIN -- (C1)
|
|
|
195 I := IDENT_INT (-1);
|
|
|
196 T2.E2 (I, "-1");
|
|
|
197 FAILED ("CONSTRAINT_ERROR NOT RAISED FOR E2 (-1)");
|
|
|
198 EXCEPTION
|
|
|
199 WHEN CONSTRAINT_ERROR =>
|
|
|
200 COUNT := COUNT + 1;
|
|
|
201 WHEN OTHERS =>
|
|
|
202 FAILED ("WRONG EXCEPTION RAISED FOR E2 (-1)");
|
|
|
203 END; -- (C1)
|
|
|
204
|
|
|
205 BEGIN -- (D)
|
|
|
206 CALLED := FALSE;
|
|
|
207 D := IDENT_INT (1);
|
|
|
208 T3.E3 (D, "10");
|
|
|
209 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
|
|
|
210 "E3 (10)");
|
|
|
211 EXCEPTION
|
|
|
212 WHEN CONSTRAINT_ERROR =>
|
|
|
213 COUNT := COUNT + 1;
|
|
|
214 IF NOT CALLED THEN
|
|
|
215 FAILED ("EXCEPTION RAISED BEFORE CALL " &
|
|
|
216 "E3 (10)");
|
|
|
217 END IF;
|
|
|
218 WHEN OTHERS =>
|
|
|
219 FAILED ("WRONG EXCEPTION RAISED FOR E3 (10)");
|
|
|
220 END; -- (D)
|
|
|
221
|
|
|
222 BEGIN -- (D1)
|
|
|
223 CALLED := FALSE;
|
|
|
224 D := IDENT_INT (1);
|
|
|
225 T3.E3 (D, "-1");
|
|
|
226 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
|
|
|
227 "E3 (-1)");
|
|
|
228 EXCEPTION
|
|
|
229 WHEN CONSTRAINT_ERROR =>
|
|
|
230 COUNT := COUNT + 1;
|
|
|
231 IF NOT CALLED THEN
|
|
|
232 FAILED ("EXCEPTION RAISED BEFORE CALL " &
|
|
|
233 "E3 (-1)");
|
|
|
234 END IF;
|
|
|
235 WHEN OTHERS =>
|
|
|
236 FAILED ("WRONG EXCEPTION RAISED FOR E3 (-1)");
|
|
|
237 END; -- (D1)
|
|
|
238
|
|
|
239 BEGIN -- (E)
|
|
|
240 CALLED := FALSE;
|
|
|
241 D := 9;
|
|
|
242 T4.E4 (D, "10");
|
|
|
243 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
|
|
|
244 "E4 (10)");
|
|
|
245 EXCEPTION
|
|
|
246 WHEN CONSTRAINT_ERROR =>
|
|
|
247 COUNT := COUNT + 1;
|
|
|
248 IF NOT CALLED THEN
|
|
|
249 FAILED ("EXCEPTION RAISED BEFORE CALL " &
|
|
|
250 "E4 (10)");
|
|
|
251 END IF;
|
|
|
252 WHEN OTHERS =>
|
|
|
253 FAILED ("WRONG EXCEPTION RAISED FOR E4 (10)");
|
|
|
254 END; -- (E)
|
|
|
255
|
|
|
256 BEGIN -- (E1)
|
|
|
257 CALLED := FALSE;
|
|
|
258 D := 0;
|
|
|
259 T4.E4 (D, "-1");
|
|
|
260 FAILED ("CONSTRAINT_ERROR NOT RAISED ON RETURN FROM " &
|
|
|
261 "E4 (-1)");
|
|
|
262 EXCEPTION
|
|
|
263 WHEN CONSTRAINT_ERROR =>
|
|
|
264 COUNT := COUNT + 1;
|
|
|
265 IF NOT CALLED THEN
|
|
|
266 FAILED ("EXCEPTION RAISED BEFORE CALL " &
|
|
|
267 "E4 (-1)");
|
|
|
268 END IF;
|
|
|
269 WHEN OTHERS =>
|
|
|
270 FAILED ("WRONG EXCEPTION RAISED FOR E4 (-1)");
|
|
|
271 END; -- (E1)
|
|
|
272
|
|
|
273 IF COUNT /= 8 THEN
|
|
|
274 FAILED ("INCORRECT NUMBER OF CONSTRAINT_ERRORS RAISED");
|
|
|
275 END IF;
|
|
|
276
|
|
|
277 RESULT;
|
|
|
278
|
|
|
279 END C95085A;
|
