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/] [c95067a.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
-- C95067A.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 A FORMAL PARAMETER OF MODE IN OR IN OUT CAN BE OF A
26
-- LIMITED TYPE, INCLUDING A COMPOSITE LIMITED TYPE.
27
 
28
-- JWC 6/20/85
29
 
30
WITH REPORT; USE REPORT;
31
PROCEDURE C95067A IS
32
 
33
     PACKAGE PKG IS
34
 
35
          TYPE ITYPE IS LIMITED PRIVATE;
36
 
37
          TASK T1 IS
38
 
39
               ENTRY LOOK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
40
 
41
               ENTRY LOOK_INOUT_I (X : IN OUT ITYPE; V : INTEGER;
42
                                   M : STRING);
43
 
44
               ENTRY SET_I (X : IN OUT ITYPE; V : INTEGER);
45
 
46
          END T1;
47
 
48
          SUBTYPE INT_0_20 IS INTEGER RANGE 0 .. 20;
49
          TYPE VRTYPE (C : INT_0_20 := 20) IS LIMITED PRIVATE;
50
 
51
          TASK T2 IS
52
 
53
               ENTRY LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
54
                                 I : INTEGER; S : STRING; M : STRING);
55
 
56
               ENTRY LOOK_INOUT_VR (X : IN OUT VRTYPE; C : INTEGER;
57
                                    I : INTEGER; S : STRING;
58
                                    M : STRING);
59
 
60
               ENTRY SET_VR (X : IN OUT VRTYPE; C : INTEGER;
61
                             I : INTEGER; S : STRING);
62
 
63
          END T2;
64
 
65
     PRIVATE
66
 
67
          TYPE ITYPE IS NEW INTEGER RANGE 0 .. 99;
68
 
69
          TYPE VRTYPE (C : INT_0_20 := 20) IS
70
               RECORD
71
                    I : INTEGER;
72
                    S : STRING (1 .. C);
73
               END RECORD;
74
 
75
     END PKG;
76
 
77
     USE PKG;
78
 
79
     I1 : ITYPE;
80
 
81
     TYPE ATYPE IS ARRAY (1 .. 3) OF ITYPE;
82
 
83
     A1 : ATYPE;
84
 
85
     VR1 : VRTYPE;
86
 
87
     D : CONSTANT INT_0_20 := 10;
88
 
89
     TYPE RTYPE IS
90
          RECORD
91
               J : ITYPE;
92
               R : VRTYPE (D);
93
          END RECORD;
94
 
95
     R1 : RTYPE;
96
 
97
     PACKAGE BODY PKG IS
98
 
99
          TASK BODY T1 IS
100
          BEGIN
101
               LOOP
102
                    SELECT
103
                         ACCEPT LOOK_IN_I (X : IN ITYPE; V : INTEGER;
104
                                           M : STRING) DO
105
                              IF INTEGER (X) /= V THEN
106
                                   FAILED ("WRONG SCALAR VALUE - " & M);
107
                              END IF;
108
                         END LOOK_IN_I;
109
                    OR
110
                         ACCEPT LOOK_INOUT_I (X : IN OUT ITYPE;
111
                                              V : INTEGER;
112
                                              M : STRING) DO
113
                              IF INTEGER (X) /= V THEN
114
                                   FAILED ("WRONG SCALAR VALUE - " & M);
115
                              END IF;
116
                         END LOOK_INOUT_I;
117
                    OR
118
                         ACCEPT SET_I (X : IN OUT ITYPE; V : INTEGER) DO
119
                              X := ITYPE (IDENT_INT (V));
120
                         END SET_I;
121
                    OR
122
                         TERMINATE;
123
                    END SELECT;
124
               END LOOP;
125
          END T1;
126
 
127
          TASK BODY T2 IS
128
          BEGIN
129
               LOOP
130
                    SELECT
131
                         ACCEPT LOOK_IN_VR (X : IN VRTYPE; C : INTEGER;
132
                                            I : INTEGER; S : STRING;
133
                                            M : STRING) DO
134
                              IF (X.C /= C OR X.I /= I) OR ELSE
135
                                 X.S /= S THEN
136
                                   FAILED ("WRONG COMPOSITE VALUE - " &
137
                                           M);
138
                              END IF;
139
                         END LOOK_IN_VR;
140
                    OR
141
                         ACCEPT LOOK_INOUT_VR (X : IN OUT VRTYPE;
142
                                               C : INTEGER; I : INTEGER;
143
                                               S : STRING;
144
                                               M : STRING) DO
145
                              IF (X.C /= C OR X.I /= I) OR ELSE
146
                                 X.S /= S THEN
147
                                   FAILED ("WRONG COMPOSITE VALUE - " &
148
                                           M);
149
                              END IF;
150
                         END LOOK_INOUT_VR;
151
                    OR
152
                         ACCEPT SET_VR (X : IN OUT VRTYPE; C : INTEGER;
153
                                        I : INTEGER; S : STRING) DO
154
                              X := (IDENT_INT(C), IDENT_INT(I),
155
                                    IDENT_STR(S));
156
                         END SET_VR;
157
                    OR
158
                         TERMINATE;
159
                    END SELECT;
160
               END LOOP;
161
          END T2;
162
 
163
     BEGIN
164
          I1 := ITYPE (IDENT_INT(2));
165
 
166
          FOR I IN A1'RANGE LOOP
167
               A1 (I) := ITYPE (3 + IDENT_INT(I));
168
          END LOOP;
169
 
170
          VR1 := (IDENT_INT(5), IDENT_INT(4), IDENT_STR("01234"));
171
 
172
          R1.J := ITYPE (IDENT_INT(6));
173
          R1.R := (IDENT_INT(D), IDENT_INT(19),
174
                   IDENT_STR("ABCDEFGHIJ"));
175
     END PKG;
176
 
177
     TASK T3 IS
178
          ENTRY CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING);
179
 
180
          ENTRY CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
181
                               NV : INTEGER; M : STRING);
182
 
183
          ENTRY CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING);
184
 
185
          ENTRY CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
186
                               NV : INTEGER; M : STRING);
187
 
188
          ENTRY CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
189
                             S : STRING; M : STRING);
190
 
191
          ENTRY CHECK_INOUT_VR (X : IN OUT VRTYPE;
192
                               OC : INTEGER; OI : INTEGER; OS : STRING;
193
                               NC : INTEGER; NI : INTEGER; NS : STRING;
194
                               M : STRING);
195
 
196
          ENTRY CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
197
                            I : INTEGER; S : STRING; M : STRING);
198
 
199
          ENTRY CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
200
                              OC : INTEGER; OI : INTEGER; OS : STRING;
201
                              NJ : INTEGER;
202
                              NC : INTEGER; NI : INTEGER; NS : STRING;
203
                              M : STRING);
204
     END T3;
205
 
206
     TASK BODY T3 IS
207
     BEGIN
208
          ACCEPT CHECK_IN_I (X : IN ITYPE; V : INTEGER; M : STRING) DO
209
               T1.LOOK_IN_I (X, V, M);
210
          END CHECK_IN_I;
211
 
212
          ACCEPT CHECK_INOUT_I (X : IN OUT ITYPE; OV : INTEGER;
213
                                NV : INTEGER; M : STRING) DO
214
               T1.LOOK_INOUT_I (X, OV, M & " - A");
215
               T1.SET_I (X, NV);
216
               T1.LOOK_INOUT_I (X, NV, M & " - B");
217
               T1.LOOK_IN_I (X, NV, M & " - C");
218
          END CHECK_INOUT_I;
219
 
220
          ACCEPT CHECK_IN_A (X : IN ATYPE; V : INTEGER; M : STRING) DO
221
               FOR I IN X'RANGE LOOP
222
                    T1.LOOK_IN_I (X(I), V+I, M & " -" &
223
                                             INTEGER'IMAGE (I));
224
               END LOOP;
225
          END CHECK_IN_A;
226
 
227
          ACCEPT CHECK_INOUT_A (X : IN OUT ATYPE; OV : INTEGER;
228
                                NV : INTEGER; M : STRING) DO
229
               FOR I IN X'RANGE LOOP
230
                    T1.LOOK_INOUT_I (X(I), OV+I, M & " - A" &
231
                                                 INTEGER'IMAGE (I));
232
                    T1.SET_I (X(I), NV+I);
233
                    T1.LOOK_INOUT_I (X(I), NV+I, M & " - B" &
234
                                                 INTEGER'IMAGE (I));
235
                    T1.LOOK_IN_I (X(I), NV+I, M & " - C" &
236
                                              INTEGER'IMAGE (I));
237
               END LOOP;
238
          END CHECK_INOUT_A;
239
 
240
          ACCEPT CHECK_IN_VR (X : IN VRTYPE; C : INTEGER; I : INTEGER;
241
                              S : STRING; M : STRING) DO
242
               T2.LOOK_IN_VR (X, C, I, S, M);
243
          END CHECK_IN_VR;
244
 
245
          ACCEPT CHECK_INOUT_VR (X : IN OUT VRTYPE;
246
                                 OC : INTEGER; OI : INTEGER;
247
                                 OS : STRING;
248
                                 NC : INTEGER; NI : INTEGER;
249
                                 NS : STRING;
250
                                 M : STRING) DO
251
               T2.LOOK_INOUT_VR (X, OC, OI, OS, M & " - A");
252
               T2.SET_VR (X, NC, NI, NS);
253
               T2.LOOK_INOUT_VR (X, NC, NI, NS, M & " - B");
254
               T2.LOOK_IN_VR (X, NC, NI, NS, M & " - C");
255
          END CHECK_INOUT_VR;
256
 
257
          ACCEPT CHECK_IN_R (X : IN RTYPE; J : INTEGER; C : INTEGER;
258
                             I : INTEGER; S : STRING; M : STRING) DO
259
               T1.LOOK_IN_I (X.J, J, M & " - A");
260
               T2.LOOK_IN_VR (X.R, C, I, S, M & " - B");
261
          END CHECK_IN_R;
262
 
263
          ACCEPT CHECK_INOUT_R (X : IN OUT RTYPE; OJ : INTEGER;
264
                                OC : INTEGER; OI : INTEGER; OS : STRING;
265
                                NJ : INTEGER;
266
                                NC : INTEGER; NI : INTEGER; NS : STRING;
267
                                M : STRING) DO
268
               T1.LOOK_INOUT_I (X.J, OJ, M & " - A");
269
               T2.LOOK_INOUT_VR (X.R, OC, OI, OS, M & " - B");
270
               T1.SET_I (X.J, NJ);
271
               T2.SET_VR (X.R, NC, NI, NS);
272
               T1.LOOK_INOUT_I (X.J, NJ, M & " - C");
273
               T2.LOOK_INOUT_VR (X.R, NC, NI, NS, M & " - D");
274
               T1.LOOK_IN_I (X.J, NJ, M & " - E");
275
               T2.LOOK_IN_VR (X.R, NC, NI, NS, M & " - F");
276
          END CHECK_INOUT_R;
277
     END T3;
278
 
279
BEGIN
280
     TEST ("C95067A", "CHECK THAT LIMITED PRIVATE/COMPOSITE TYPES " &
281
                      "CAN BE USED AS IN OR IN OUT FORMAL PARAMETERS");
282
 
283
     T3.CHECK_IN_I (I1, 2, "IN I");
284
 
285
     T3.CHECK_INOUT_I (I1, 2, 5, "INOUT I");
286
 
287
     T3.CHECK_IN_A (A1, 3, "IN A");
288
 
289
     T3.CHECK_INOUT_A (A1, 3, 17, "INOUT A");
290
 
291
     T3.CHECK_IN_VR (VR1, 5, 4, "01234", "IN VR");
292
 
293
     T3.CHECK_INOUT_VR (VR1, 5, 4, "01234", 10, 11, "9876543210",
294
                        "INOUT VR");
295
 
296
     T3.CHECK_IN_R (R1, 6, D, 19, "ABCDEFGHIJ", "IN R");
297
 
298
     T3.CHECK_INOUT_R (R1, 6, D, 19, "ABCDEFGHIJ", 13, D, 5,
299
                       "ZYXWVUTSRQ", "INOUT R");
300
 
301
     RESULT;
302
END C95067A;

powered by: WebSVN 2.1.0

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