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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c9/] [c95087a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C95087A.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 UNCONSTRAINED RECORD, PRIVATE, LIMITED PRIVATE, AND ARRAY
26
--   FORMAL PARAMETERS USE THE CONSTRAINTS OF ACTUAL PARAMETERS.
27
--   SUBTESTS ARE:
28
--        (A) RECORD TYPE, UNCONSTRAINED ACTUALS, DEFAULTS.
29
--        (B) PRIVATE TYPE, CONSTRAINED ACTUALS, NO DEFAULTS.
30
--        (C) LIMITED PRIVATE TYPE, UNCONSTRAINED ACTUALS, NO DEFAULTS.
31
--        (D) ARRAY TYPE, CONSTRAINED ACTUALS, DEFAULTS.
32
 
33
-- GLH  7/19/85
34
-- JRK 8/23/85
35
 
36
WITH REPORT; USE REPORT;
37
PROCEDURE C95087A IS
38
 
39
BEGIN
40
     TEST ("C95087A", "CHECK USE OF ACTUAL CONSTRAINTS BY " &
41
                      "UNCONSTRAINED FORMAL PARAMETERS");
42
 
43
     DECLARE  -- (A)
44
 
45
          PACKAGE PKG IS
46
 
47
              SUBTYPE INT IS INTEGER RANGE 0..100;
48
 
49
              TYPE RECTYPE (CONSTRAINT : INT := 80) IS
50
                    RECORD
51
                         INTFIELD : INTEGER;
52
                         STRFIELD : STRING (1..CONSTRAINT);
53
                    END RECORD;
54
 
55
               REC1 : RECTYPE := (10,10,"0123456789");
56
               REC2 : RECTYPE := (17,7,"C95087A..........");
57
               REC3 : RECTYPE := (1,1,"A");
58
               REC4 : RECTYPE;  -- 80.
59
 
60
               TASK T1 IS
61
                    ENTRY E1 (REC1 : IN RECTYPE := (2,0,"AB");
62
                              REC2 : OUT RECTYPE;
63
                              REC3 : IN OUT RECTYPE);
64
               END T1;
65
 
66
               TASK T2 IS
67
                    ENTRY E2 (REC : OUT RECTYPE);
68
               END T2;
69
          END PKG;
70
 
71
          PACKAGE BODY PKG IS
72
 
73
               TASK BODY T1 IS
74
               BEGIN
75
                    ACCEPT E1 (REC1 : IN RECTYPE := (2,0,"AB");
76
                               REC2 : OUT RECTYPE;
77
                               REC3 : IN OUT RECTYPE) DO
78
 
79
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
80
                              FAILED ("RECORD TYPE IN PARAMETER " &
81
                                      "DID NOT USE CONSTRAINT " &
82
                                      "OF ACTUAL");
83
                         END IF;
84
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
85
                              FAILED ("RECORD TYPE OUT " &
86
                                      "PARAMETER DID NOT USE " &
87
                                      "CONSTRAINT OF ACTUAL");
88
                         END IF;
89
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
90
                              FAILED ("RECORD TYPE IN OUT " &
91
                                      "PARAMETER DID NOT USE " &
92
                                      "CONSTRAINT OF ACTUAL");
93
                         END IF;
94
                         REC2 := PKG.REC2;
95
                    END E1;
96
               END T1;
97
 
98
               TASK BODY T2 IS
99
               BEGIN
100
                    ACCEPT E2 (REC : OUT RECTYPE) DO
101
                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
102
                              FAILED ("RECORD TYPE OUT " &
103
                                      "PARAMETER DID " &
104
                                      "NOT USE CONSTRAINT OF " &
105
                                      "UNINITIALIZED ACTUAL");
106
                         END IF;
107
                         REC := (10,10,"9876543210");
108
                    END E2;
109
               END T2;
110
          END PKG;
111
 
112
     BEGIN  -- (A)
113
 
114
          PKG.T1.E1 (PKG.REC1, PKG.REC2, PKG.REC3);
115
          PKG.T2.E2 (PKG.REC4);
116
 
117
     END;   -- (A)
118
 
119
     ---------------------------------------------
120
 
121
B :  DECLARE  -- (B)
122
 
123
          PACKAGE PKG IS
124
 
125
               SUBTYPE INT IS INTEGER RANGE 0..100;
126
 
127
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS PRIVATE;
128
 
129
 
130
               TASK T1 IS
131
                    ENTRY E1 (REC1 : IN RECTYPE;
132
                              REC2 : OUT RECTYPE;
133
                              REC3 : IN OUT RECTYPE);
134
               END T1;
135
 
136
               TASK T2 IS
137
                    ENTRY E2  (REC : OUT RECTYPE);
138
               END T2;
139
 
140
          PRIVATE
141
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
142
                    RECORD
143
                         INTFIELD : INTEGER;
144
                         STRFIELD : STRING (1..CONSTRAINT);
145
                    END RECORD;
146
          END PKG;
147
 
148
          REC1 : PKG.RECTYPE (10);
149
          REC2 : PKG.RECTYPE (17);
150
          REC3 : PKG.RECTYPE (1);
151
          REC4 : PKG.RECTYPE (10);
152
 
153
          PACKAGE BODY PKG IS
154
 
155
               TASK BODY T1 IS
156
               BEGIN
157
                    ACCEPT E1 (REC1 : IN RECTYPE;
158
                               REC2 : OUT RECTYPE;
159
                               REC3 : IN OUT RECTYPE) DO
160
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
161
                              FAILED ("PRIVATE TYPE IN " &
162
                                      "PARAMETER DID " &
163
                                      "NOT USE CONSTRAINT OF " &
164
                                      "ACTUAL");
165
                         END IF;
166
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
167
                              FAILED ("PRIVATE TYPE OUT " &
168
                                      "PARAMETER DID " &
169
                                      "NOT USE CONSTRAINT OF " &
170
                                      "ACTUAL");
171
                         END IF;
172
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
173
                              FAILED ("PRIVATE TYPE IN OUT " &
174
                                      "PARAMETER DID " &
175
                                      "NOT USE CONSTRAINT OF " &
176
                                      "ACTUAL");
177
                         END IF;
178
                         REC2 := B.REC2;
179
                    END E1;
180
               END T1;
181
 
182
               TASK BODY T2 IS
183
               BEGIN
184
                    ACCEPT E2 (REC : OUT RECTYPE) DO
185
                         IF REC.CONSTRAINT /= IDENT_INT (10) THEN
186
                              FAILED ("PRIVATE TYPE OUT " &
187
                                      "PARAMETER DID " &
188
                                      "NOT USE CONSTRAINT OF " &
189
                                      "UNINITIALIZED ACTUAL");
190
                         END IF;
191
                         REC := (10,10,"9876543210");
192
                    END E2;
193
               END T2;
194
 
195
          BEGIN
196
               REC1 := (10,10,"0123456789");
197
               REC2 := (17,7,"C95087A..........");
198
               REC3 := (1,1,"A");
199
          END PKG;
200
 
201
     BEGIN  -- (B)
202
 
203
          PKG.T1.E1 (REC1, REC2, REC3);
204
          PKG.T2.E2 (REC4);
205
 
206
     END B;  -- (B)
207
 
208
     ---------------------------------------------
209
 
210
C :  DECLARE  -- (C)
211
 
212
          PACKAGE PKG IS
213
 
214
               SUBTYPE INT IS INTEGER RANGE 0..100;
215
 
216
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
217
                    LIMITED PRIVATE;
218
 
219
               TASK T1 IS
220
                    ENTRY E1 (REC1 : IN RECTYPE;
221
                              REC2 : OUT RECTYPE;
222
                              REC3 : IN OUT RECTYPE);
223
               END T1;
224
 
225
               TASK T2 IS
226
                    ENTRY E2 (REC : OUT RECTYPE);
227
               END T2;
228
 
229
          PRIVATE
230
               TYPE RECTYPE (CONSTRAINT : INT := 80) IS
231
                    RECORD
232
                         INTFIELD : INTEGER;
233
                         STRFIELD : STRING (1..CONSTRAINT);
234
                    END RECORD;
235
          END PKG;
236
 
237
          REC1 : PKG.RECTYPE;     -- 10.
238
          REC2 : PKG.RECTYPE;     -- 17.
239
          REC3 : PKG.RECTYPE;     --  1.
240
          REC4 : PKG.RECTYPE;     -- 80.
241
 
242
          PACKAGE BODY PKG IS
243
 
244
               TASK BODY T1 IS
245
               BEGIN
246
                    ACCEPT E1 (REC1 : IN RECTYPE;
247
                               REC2 : OUT RECTYPE;
248
                               REC3 : IN OUT RECTYPE) DO
249
                         IF REC1.CONSTRAINT /= IDENT_INT (10) THEN
250
                              FAILED ("LIMITED PRIVATE TYPE IN " &
251
                                      "PARAMETER DID NOT USE " &
252
                                      "CONSTRAINT OF ACTUAL");
253
                         END IF;
254
                         IF REC2.CONSTRAINT /= IDENT_INT (17) THEN
255
                              FAILED ("LIMITED PRIVATE TYPE OUT " &
256
                                      "PARAMETER DID NOT USE " &
257
                                      "CONSTRAINT OF " &
258
                                      "ACTUAL");
259
                         END IF;
260
                         IF REC3.CONSTRAINT /= IDENT_INT (1) THEN
261
                              FAILED ("LIMITED PRIVATE TYPE IN " &
262
                                      "OUT PARAMETER DID NOT " &
263
                                      "USE CONSTRAINT OF ACTUAL");
264
                         END IF;
265
                         REC2 := C.REC2;
266
                    END E1;
267
               END T1;
268
 
269
               TASK BODY T2 IS
270
               BEGIN
271
                    ACCEPT E2 (REC : OUT RECTYPE) DO
272
                         IF REC.CONSTRAINT /= IDENT_INT (80) THEN
273
                              FAILED ("LIMITED PRIVATE TYPE OUT " &
274
                                      "PARAMETER DID NOT USE " &
275
                                      "CONSTRAINT OF UNINITIALIZED " &
276
                                      "ACTUAL");
277
                         END IF;
278
                         REC := (10,10,"9876543210");
279
                    END E2;
280
               END T2;
281
 
282
          BEGIN
283
               REC1 := (10,10,"0123456789");
284
               REC2 := (17,7,"C95087A..........");
285
               REC3 := (1,1,"A");
286
          END PKG;
287
 
288
     BEGIN  -- (C)
289
 
290
          PKG.T1.E1 (REC1, REC2, REC3);
291
          PKG.T2.E2 (REC4);
292
 
293
     END C;   -- (C)
294
 
295
     ---------------------------------------------
296
 
297
D :  DECLARE  -- (D)
298
 
299
          TYPE ATYPE IS ARRAY (INTEGER RANGE <>, POSITIVE RANGE <>) OF
300
               CHARACTER;
301
 
302
          A1, A2, A3 : ATYPE (-1..1, 4..5) := (('A','B'),
303
                                               ('C','D'),
304
                                               ('E','F'));
305
 
306
          A4  : ATYPE (-1..1, 4..5);
307
 
308
          CA1 : CONSTANT ATYPE (8..9, -7..INTEGER'FIRST) :=
309
                               (8..9 => (-7..INTEGER'FIRST => 'A'));
310
 
311
          S1  : STRING (1..INTEGER'FIRST) := "";
312
          S2  : STRING (-5..-7)           := "";
313
          S3  : STRING (1..0)             := "";
314
 
315
          TASK T1 IS
316
               ENTRY E1 (A1 : IN ATYPE := CA1;
317
                         A2 : OUT ATYPE;
318
                         A3 : IN OUT ATYPE);
319
          END T1;
320
 
321
          TASK T2 IS
322
               ENTRY E2 (A4 : OUT ATYPE);
323
          END T2;
324
 
325
          TASK T3 IS
326
               ENTRY E3 (S1 : IN STRING;
327
                         S2 : IN OUT STRING;
328
                         S3 : OUT STRING);
329
          END T3;
330
 
331
          TASK BODY T1 IS
332
          BEGIN
333
               ACCEPT E1 (A1 : IN ATYPE := CA1;  A2 : OUT ATYPE;
334
                          A3 : IN OUT ATYPE) DO
335
                    IF A1'FIRST(1) /= IDENT_INT (-1) OR
336
                       A1'LAST(1)  /= IDENT_INT (1)  OR
337
                       A1'FIRST(2) /= IDENT_INT (4)  OR
338
                       A1'LAST(2)  /= IDENT_INT (5)  THEN
339
                         FAILED ("ARRAY TYPE IN PARAMETER DID " &
340
                                 "NOT USE CONSTRAINTS OF ACTUAL");
341
                    END IF;
342
                    IF A2'FIRST(1) /= IDENT_INT (-1) OR
343
                       A2'LAST(1)  /= IDENT_INT (1)  OR
344
                       A2'FIRST(2) /= IDENT_INT (4)  OR
345
                       A2'LAST(2)  /= IDENT_INT (5)  THEN
346
                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
347
                                 "NOT USE CONSTRAINTS OF ACTUAL");
348
                    END IF;
349
                    IF A3'FIRST(1) /= IDENT_INT (-1) OR
350
                       A3'LAST(1)  /= IDENT_INT (1)  OR
351
                       A3'FIRST(2) /= IDENT_INT (4)  OR
352
                       A3'LAST(2)  /= IDENT_INT (5)  THEN
353
                         FAILED ("ARRAY TYPE IN OUT PARAMETER " &
354
                                 "DID NOT USE CONSTRAINTS OF " &
355
                                 "ACTUAL");
356
                    END IF;
357
                    A2 := D.A2;
358
               END E1;
359
          END T1;
360
 
361
          TASK BODY T2 IS
362
          BEGIN
363
               ACCEPT E2 (A4 : OUT ATYPE) DO
364
                    IF A4'FIRST(1) /= IDENT_INT (-1) OR
365
                       A4'LAST(1)  /= IDENT_INT (1)  OR
366
                       A4'FIRST(2) /= IDENT_INT (4)  OR
367
                       A4'LAST(2)  /= IDENT_INT (5)  THEN
368
                         FAILED ("ARRAY TYPE OUT PARAMETER DID " &
369
                                 "NOT USE CONSTRAINTS OF " &
370
                                 "UNINITIALIZED ACTUAL");
371
                    END IF;
372
                    A4 := A2;
373
               END E2;
374
          END T2;
375
 
376
          TASK BODY T3 IS
377
          BEGIN
378
               ACCEPT E3 (S1 : IN STRING;
379
                          S2 : IN OUT STRING;
380
                          S3 : OUT STRING) DO
381
                    IF S1'FIRST /= IDENT_INT (1) OR
382
                       S1'LAST  /= IDENT_INT (INTEGER'FIRST) THEN
383
                         FAILED ("STRING TYPE IN PARAMETER DID " &
384
                                 "NOT USE CONSTRAINTS OF ACTUAL " &
385
                                 "NULL STRING");
386
                    END IF;
387
                    IF S2'FIRST /= IDENT_INT (-5) OR
388
                       S2'LAST  /= IDENT_INT (-7) THEN
389
                         FAILED ("STRING TYPE IN OUT PARAMETER " &
390
                                 "DID NOT USE CONSTRAINTS OF " &
391
                                 "ACTUAL NULL STRING");
392
                    END IF;
393
                    IF S3'FIRST /= IDENT_INT (1) OR
394
                       S3'LAST  /= IDENT_INT (0) THEN
395
                         FAILED ("STRING TYPE OUT PARAMETER DID NOT " &
396
                                 "USE CONSTRAINTS OF ACTUAL NULL " &
397
                                 "STRING");
398
                    END IF;
399
                    S3 := "";
400
               END E3;
401
          END T3;
402
 
403
     BEGIN  -- (D)
404
 
405
          T1.E1 (A1, A2, A3);
406
          T2.E2 (A4);
407
          T3.E3 (S1, S2, S3);
408
 
409
     END D;  -- (D)
410
 
411
     RESULT;
412
END C95087A;

powered by: WebSVN 2.1.0

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