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
38WITH REPORT;  USE REPORT;
39PROCEDURE 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
156BEGIN
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
279END C95085A;
280