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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95086c.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn 
-- C95086C.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 NOT RAISED FOR ACCESS PARAMETERS
26 
--   AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL
27 
--   ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS
28 
--   DIFFERENT CONSTRAINTS.
29 
--
30 
--   SUBTESTS ARE:
31 
--       (A) IN OUT MODE, STATIC PRIVATE DISCRIMINANT.
32 
--       (B) OUT MODE, DYNAMIC TWO DIMENSIONAL BOUNDS.
33 
--       (C) SAME AS (A), WITH TYPE CONVERSION.
34 
--       (D) SAME AS (B), WITH TYPE CONVERSION.
35 
 
36 
-- RJW 1/29/86
37 
 
38 
WITH REPORT; USE REPORT;
39 
PROCEDURE C95086C IS
40 
 
41 
BEGIN
42 
     TEST ("C95086C", "CHECK THAT CONSTRAINT_ERROR IS NOT RAISED " &
43 
           "AFTER THE ENTRY CALL, WHEN AN IN OUT OR OUT FORMAL " &
44 
           "ACCESS VALUE IS NULL, AND THE ACTUAL PARAMETER HAS " &
45 
           "DIFFERENT CONSTRAINTS" );
46 
 
47 
     --------------------------------------------------
48 
 
49 
     DECLARE -- (A)
50 
 
51 
          PACKAGE PKG IS
52 
               TYPE E IS (E1, E2);
53 
               TYPE T (D : E := E1) IS PRIVATE;
54 
          PRIVATE
55 
               TYPE T (D : E := E1) IS
56 
                    RECORD
57 
                         I : INTEGER;
58 
                         CASE D IS
59 
                              WHEN E1 =>
60 
                                   B : BOOLEAN;
61 
                              WHEN E2 =>
62 
                                   C : CHARACTER;
63 
                         END CASE;
64 
                    END RECORD;
65 
          END PKG;
66 
 
67 
          USE PKG;
68 
 
69 
          TYPE A IS ACCESS T;
70 
          SUBTYPE SA IS A (E2);
71 
          V : A (E1) := NULL;
72 
          ENTERED : BOOLEAN := FALSE;
73 
 
74 
          TASK T1 IS
75 
               ENTRY P (X : IN OUT SA);
76 
          END T1;
77 
 
78 
          TASK BODY T1 IS
79 
          BEGIN
80 
               ACCEPT P (X : IN OUT SA) DO
81 
                    ENTERED := TRUE;
82 
                    X := NULL;
83 
               END P;
84 
          EXCEPTION
85 
               WHEN OTHERS =>
86 
                    FAILED ("EXCEPTION RAISED IN TASK - (A)");
87 
          END T1;
88 
 
89 
     BEGIN -- (A)
90 
 
91 
          T1.P (V);
92 
 
93 
     EXCEPTION
94 
          WHEN CONSTRAINT_ERROR =>
95 
               IF NOT ENTERED THEN
96 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (A)");
97 
               ELSE
98 
                    FAILED ("EXCEPTION RAISED ON RETURN - (A)");
99 
               END IF;
100 
          WHEN OTHERS =>
101 
               FAILED ("EXCEPTION RAISED - (A)");
102 
     END; -- (A)
103 
 
104 
     --------------------------------------------------
105 
 
106 
     DECLARE -- (B)
107 
 
108 
          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
109 
                    INTEGER;
110 
 
111 
          TYPE A IS ACCESS T;
112 
          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
113 
          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
114 
                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
115 
          ENTERED : BOOLEAN := FALSE;
116 
 
117 
          TASK T1 IS
118 
               ENTRY P (X : OUT SA);
119 
          END T1;
120 
 
121 
          TASK BODY T1 IS
122 
          BEGIN
123 
               ACCEPT P (X : OUT SA) DO
124 
                    ENTERED := TRUE;
125 
                    X := NULL;
126 
               END P;
127 
          EXCEPTION
128 
               WHEN OTHERS =>
129 
                    FAILED ("EXCEPTION RAISED IN TASK - (B)");
130 
          END T1;
131 
 
132 
     BEGIN -- (B)
133 
 
134 
          T1.P (V);
135 
 
136 
     EXCEPTION
137 
          WHEN CONSTRAINT_ERROR =>
138 
               IF NOT ENTERED THEN
139 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (B)");
140 
               ELSE
141 
                    FAILED ("EXCEPTION RAISED ON RETURN - (B)");
142 
               END IF;
143 
          WHEN OTHERS =>
144 
               FAILED ("EXCEPTION RAISED - (B)");
145 
     END; -- (B)
146 
 
147 
     --------------------------------------------------
148 
 
149 
     DECLARE -- (C)
150 
 
151 
          PACKAGE PKG IS
152 
               TYPE E IS (E1, E2);
153 
               TYPE T (D : E := E1) IS PRIVATE;
154 
          PRIVATE
155 
               TYPE T (D : E := E1) IS
156 
                    RECORD
157 
                         I : INTEGER;
158 
                         CASE D IS
159 
                              WHEN E1 =>
160 
                                   B : BOOLEAN;
161 
                              WHEN E2 =>
162 
                                   C : CHARACTER;
163 
                         END CASE;
164 
                    END RECORD;
165 
          END PKG;
166 
 
167 
          USE PKG;
168 
 
169 
          TYPE A IS ACCESS T;
170 
          SUBTYPE SA IS A (E2);
171 
          V : A (E1) := NULL;
172 
          ENTERED : BOOLEAN := FALSE;
173 
 
174 
          TASK T1 IS
175 
               ENTRY P (X : IN OUT SA);
176 
          END T1;
177 
 
178 
          TASK BODY T1 IS
179 
          BEGIN
180 
               ACCEPT P (X : IN OUT SA) DO
181 
                    ENTERED := TRUE;
182 
                    X := NULL;
183 
               END P;
184 
          EXCEPTION
185 
               WHEN OTHERS =>
186 
                    FAILED ("EXCEPTION RAISED IN TASK - (C)");
187 
          END T1;
188 
 
189 
     BEGIN -- (C)
190 
 
191 
          T1.P (SA(V));
192 
 
193 
     EXCEPTION
194 
          WHEN CONSTRAINT_ERROR =>
195 
               IF NOT ENTERED THEN
196 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (C)");
197 
               ELSE
198 
                    FAILED ("EXCEPTION RAISED ON RETURN - (C)");
199 
               END IF;
200 
          WHEN OTHERS =>
201 
               FAILED ("EXCEPTION RAISED - (C)");
202 
     END; -- (C)
203 
 
204 
     --------------------------------------------------
205 
 
206 
     DECLARE -- (D)
207 
 
208 
          TYPE T IS ARRAY (CHARACTER RANGE <>, BOOLEAN RANGE <>) OF
209 
                    INTEGER;
210 
 
211 
          TYPE A IS ACCESS T;
212 
          SUBTYPE SA IS A ('D'..'F', FALSE..FALSE);
213 
          V : A (IDENT_CHAR('A') .. IDENT_CHAR('B'),
214 
                 IDENT_BOOL(TRUE) .. IDENT_BOOL(TRUE)) := NULL;
215 
          ENTERED : BOOLEAN := FALSE;
216 
 
217 
          TASK T1 IS
218 
               ENTRY P (X : OUT SA);
219 
          END T1;
220 
 
221 
          TASK BODY T1 IS
222 
          BEGIN
223 
               ACCEPT P (X : OUT SA) DO
224 
                    ENTERED := TRUE;
225 
                    X := NULL;
226 
               END P;
227 
          EXCEPTION
228 
               WHEN OTHERS =>
229 
                    FAILED ("EXCEPTION RAISED IN TASK - (D)");
230 
          END T1;
231 
 
232 
     BEGIN -- (D)
233 
 
234 
          T1.P (SA(V));
235 
 
236 
     EXCEPTION
237 
          WHEN CONSTRAINT_ERROR =>
238 
               IF NOT ENTERED THEN
239 
                    FAILED ("EXCEPTION RAISED BEFORE CALL - (D)");
240 
               ELSE
241 
                    FAILED ("EXCEPTION RAISED ON RETURN - (D)");
242 
               END IF;
243 
          WHEN OTHERS =>
244 
               FAILED ("EXCEPTION RAISED - (D)");
245 
     END; -- (D)
246 
 
247 
     --------------------------------------------------
248 
 
249 
     RESULT;
250 
END C95086C;

powered by: WebSVN 2.1.0

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