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 149

Go to most recent revision | 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.