OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95085a.ada] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.