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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc3017c.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC3017C.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
-- OBJECTIVE:
26
--     CHECK THAT AN INSTANCE OF A GENERIC PROCEDURE MUST DECLARE A
27
--     PROCEDURE AND THAT AN INSTANCE OF A GENERIC FUNCTION MUST
28
--     DECLARE A FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS
29
--     ARE COPIED.
30
--
31
--     SUBTESTS ARE:
32
--         (A) SCALAR PARAMETERS TO PROCEDURES.
33
--         (B) SCALAR PARAMETERS TO FUNCTIONS.
34
--         (C) ACCESS PARAMETERS TO PROCEDURES.
35
--         (D) ACCESS PARAMETERS TO FUNCTIONS.
36
 
37
-- HISTORY:
38
--     EDWARD V. BERARD, 7 AUGUST 1990
39
--     CJJ 10/16/90  ADJUSTED LINES THAT WERE TOO LONG; REFORMATTED
40
--                   HEADER TO CONFORM TO ACVC STANDARDS.
41
--
42
 
43
WITH REPORT;
44
PROCEDURE CC3017C IS
45
 
46
BEGIN
47
     REPORT.TEST ("CC3017C", "CHECK THAT AN INSTANCE OF A GENERIC " &
48
                  "PROCEDURE MUST DECLARE A PROCEDURE AND THAT AN " &
49
                  "INSTANCE OF A GENERIC FUNCTION MUST DECLARE A " &
50
                  "FUNCTION. CHECK THAT SCALAR AND ACCESS PARAMETERS " &
51
                  "ARE COPIED");
52
 
53
     --------------------------------------------------
54
 
55
     SCALAR_TO_PROCS:
56
 
57
     DECLARE
58
 
59
--        (A) SCALAR PARAMETERS TO PROCEDURES.
60
 
61
          TYPE NUMBER IS RANGE 0 .. 120 ;
62
          VALUE : NUMBER ;
63
          E     : EXCEPTION ;
64
 
65
          GENERIC
66
 
67
            TYPE SCALAR_ITEM IS RANGE <> ;
68
 
69
          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
70
                       P_OUT     : OUT SCALAR_ITEM ;
71
                       P_IN_OUT : IN OUT SCALAR_ITEM) ;
72
 
73
          PROCEDURE P (P_IN     : IN SCALAR_ITEM ;
74
                       P_OUT     : OUT SCALAR_ITEM ;
75
                       P_IN_OUT : IN OUT SCALAR_ITEM) IS
76
 
77
               STORE  : SCALAR_ITEM ;
78
 
79
          BEGIN  -- P
80
 
81
               STORE := P_IN;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
82
 
83
               P_OUT := 10;
84
               IF (P_IN /= STORE) THEN
85
                    REPORT.FAILED ("ASSIGNMENT TO SCALAR OUT " &
86
                                   "PARAMETER CHANGES THE VALUE OF " &
87
                                   "INPUT PARAMETER");
88
                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
89
               END IF;
90
 
91
               P_IN_OUT := P_IN_OUT + 100;
92
               IF (P_IN /= STORE) THEN
93
                    REPORT.FAILED ("ASSIGNMENT TO SCALAR IN OUT " &
94
                                   "PARAMETER CHANGES THE VALUE OF " &
95
                                   "INPUT PARAMETER");
96
                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
97
               END IF;
98
 
99
               VALUE := VALUE + 1;
100
               IF (P_IN /= STORE) THEN
101
                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL " &
102
                                   "PARAMETER CHANGES THE VALUE OF " &
103
                                   "INPUT PARAMETER");
104
               END IF;
105
 
106
               RAISE E;  -- CHECK EXCEPTION HANDLING.
107
          END P;
108
 
109
          PROCEDURE NEW_P IS NEW P (SCALAR_ITEM => NUMBER) ;
110
 
111
     BEGIN  -- SCALAR_TO_PROCS
112
          VALUE := 0;   -- INITIALIZE VALUE SO VARIOUS CASES CAN BE DETECTED.
113
 
114
          NEW_P (P_IN     => VALUE,
115
                 P_OUT    => VALUE,
116
                 P_IN_OUT => VALUE);
117
 
118
          REPORT.FAILED ("EXCEPTION NOT RAISED - SCALARS TO PROCEDURES");
119
     EXCEPTION
120
          WHEN E =>
121
               IF (VALUE /= 1) THEN
122
                    CASE VALUE IS
123
                         WHEN 11  =>
124
                              REPORT.FAILED ("OUT ACTUAL SCALAR " &
125
                                             "PARAMETER CHANGED GLOBAL VALUE");
126
                         WHEN 101 =>
127
                              REPORT.FAILED ("IN OUT ACTUAL SCALAR " &
128
                                             "PARAMETER CHANGED GLOBAL VALUE");
129
                         WHEN 111 =>
130
                              REPORT.FAILED ("OUT AND IN OUT ACTUAL " &
131
                                             "SCALAR PARAMETERS CHANGED " &
132
                                             "GLOBAL VALUE");
133
                         WHEN OTHERS =>
134
                              REPORT.FAILED ("UNDETERMINED CHANGE TO " &
135
                                             "GLOBAL VALUE");
136
                    END CASE;
137
               END IF;
138
          WHEN OTHERS =>
139
              REPORT.FAILED ("WRONG EXCEPTION RAISED - SCALARS TO PROCEDURES");
140
     END SCALAR_TO_PROCS ;
141
 
142
     --------------------------------------------------
143
 
144
     SCALAR_TO_FUNCS:
145
 
146
     DECLARE
147
 
148
--        (B) SCALAR PARAMETERS TO FUNCTIONS.
149
 
150
          TYPE NUMBER IS RANGE 0 .. 101 ;
151
          FIRST  : NUMBER ;
152
          SECOND : NUMBER ;
153
 
154
          GENERIC
155
 
156
              TYPE ITEM IS RANGE <> ;
157
 
158
          FUNCTION F (F_IN : IN ITEM) RETURN ITEM ;
159
 
160
          FUNCTION F (F_IN : IN ITEM) RETURN ITEM IS
161
 
162
               STORE  : ITEM := F_IN;
163
 
164
          BEGIN  -- F
165
 
166
               FIRST := FIRST + 1;
167
               IF (F_IN /= STORE) THEN
168
                    REPORT.FAILED ("ASSIGNMENT TO SCALAR GLOBAL FUNCTION " &
169
                                   "PARAMETER CHANGES THE VALUE OF " &
170
                                   "INPUT PARAMETER");
171
               END IF;
172
 
173
               RETURN (100);
174
          END F;
175
 
176
          FUNCTION NEW_F IS NEW F (ITEM => NUMBER) ;
177
 
178
     BEGIN  -- SCALAR_TO_FUNCS
179
          FIRST  := 100 ;
180
          SECOND := NEW_F (FIRST) ;
181
     END SCALAR_TO_FUNCS ;
182
 
183
     --------------------------------------------------
184
 
185
     ACCESS_TO_PROCS:
186
 
187
     DECLARE
188
 
189
--        (C) ACCESS PARAMETERS TO PROCEDURES.
190
 
191
          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
192
                               SEP, OCT, NOV, DEC) ;
193
          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
194
          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
195
          TYPE DATE IS RECORD
196
              MONTH : MONTH_TYPE ;
197
              DAY   : DAY_TYPE ;
198
              YEAR  : YEAR_TYPE ;
199
          END RECORD ;
200
 
201
          TYPE DATE_ACCESS IS ACCESS DATE ;
202
          DATE_POINTER : DATE_ACCESS ;
203
 
204
          E    : EXCEPTION;
205
 
206
          GENERIC
207
 
208
            TYPE ITEM IS PRIVATE ;
209
            TYPE ACCESS_ITEM IS ACCESS ITEM ;
210
 
211
          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
212
                       P_OUT    : OUT    ACCESS_ITEM ;
213
                       P_IN_OUT : IN OUT ACCESS_ITEM) ;
214
 
215
          PROCEDURE P (P_IN     : IN     ACCESS_ITEM ;
216
                       P_OUT    : OUT    ACCESS_ITEM ;
217
                       P_IN_OUT : IN OUT ACCESS_ITEM) IS
218
 
219
               STORE  : ACCESS_ITEM ;
220
 
221
          BEGIN  -- P
222
 
223
               STORE := P_IN ;     -- SAVE VALUE OF P_IN AT PROC ENTRY.
224
 
225
               DATE_POINTER := NEW DATE'(YEAR  => 1990,
226
                                         DAY   => 7,
227
                                         MONTH => AUG) ;
228
               IF (P_IN /= STORE) THEN
229
                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL " &
230
                                   "PARAMETER CHANGES THE VALUE OF " &
231
                                   "INPUT PARAMETER");
232
                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
233
               END IF;
234
 
235
               P_OUT := NEW ITEM ;
236
               IF (P_IN /= STORE) THEN
237
                    REPORT.FAILED ("ASSIGNMENT TO ACCESS OUT " &
238
                                   "PARAMETER CHANGES THE VALUE OF " &
239
                                   "INPUT PARAMETER");
240
                    STORE := P_IN;     -- RESET STORE FOR NEXT CASE.
241
               END IF;
242
 
243
               P_IN_OUT :=  NEW ITEM ;
244
               IF (P_IN /= STORE) THEN
245
                    REPORT.FAILED ("ASSIGNMENT TO ACCESS IN OUT " &
246
                                   "PARAMETER CHANGES THE VALUE OF " &
247
                                   "INPUT PARAMETER");
248
               END IF;
249
 
250
               RAISE E;  -- CHECK EXCEPTION HANDLING.
251
          END P ;
252
 
253
          PROCEDURE NEW_P IS NEW P (ITEM         => DATE,
254
                                    ACCESS_ITEM  => DATE_ACCESS) ;
255
 
256
     BEGIN  -- ACCESS_TO_PROCS
257
          DATE_POINTER := NEW DATE'(MONTH => DEC,
258
                                    DAY   => 25,
259
                                    YEAR  => 2000) ;
260
 
261
          NEW_P (P_IN       => DATE_POINTER,
262
                   P_OUT    => DATE_POINTER,
263
                   P_IN_OUT => DATE_POINTER) ;
264
 
265
          REPORT.FAILED ("EXCEPTION NOT RAISED - ACCESS TO PROCEDURES");
266
     EXCEPTION
267
          WHEN E =>
268
               IF (DATE_POINTER.ALL /= (AUG, 7, 1990)) THEN
269
                    REPORT.FAILED ("OUT OR IN OUT ACTUAL PROCEDURE " &
270
                                   "PARAMETER VALUE CHANGED DESPITE " &
271
                                   "RAISED EXCEPTION");
272
               END IF;
273
          WHEN OTHERS =>
274
               REPORT.FAILED ("WRONG EXCEPTION RAISED - ACCESS TO PROCEDURES");
275
     END ACCESS_TO_PROCS ;
276
 
277
     --------------------------------------------------
278
 
279
     ACCESS_TO_FUNCS:
280
 
281
     DECLARE
282
 
283
--        (D) ACCESS PARAMETERS TO FUNCTIONS.
284
 
285
          TYPE MONTH_TYPE IS (JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG,
286
                               SEP, OCT, NOV, DEC) ;
287
          TYPE DAY_TYPE IS RANGE 1 .. 31 ;
288
          TYPE YEAR_TYPE IS RANGE 1904 .. 2050 ;
289
          TYPE DATE IS RECORD
290
            MONTH : MONTH_TYPE ;
291
            DAY   : DAY_TYPE ;
292
            YEAR  : YEAR_TYPE ;
293
          END RECORD ;
294
 
295
          TYPE DATE_ACCESS IS ACCESS DATE ;
296
          DATE_POINTER : DATE_ACCESS ;
297
          NEXT_DATE    : DATE_ACCESS ;
298
 
299
          GENERIC
300
 
301
            TYPE ITEM IS PRIVATE ;
302
            TYPE ACCESS_ITEM IS ACCESS ITEM ;
303
 
304
          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM ;
305
 
306
          FUNCTION F (F_IN : IN ACCESS_ITEM) RETURN ACCESS_ITEM IS
307
 
308
               STORE  : ACCESS_ITEM := F_IN ;
309
 
310
          BEGIN  -- F
311
 
312
               DATE_POINTER := NEW DATE'(YEAR  => 1990,
313
                                            DAY   => 7,
314
                                         MONTH => AUG) ;
315
               IF (F_IN /= STORE) THEN
316
                    REPORT.FAILED ("ASSIGNMENT TO ACCESS GLOBAL FUNCTION " &
317
                                   "PARAMETER CHANGES THE VALUE OF " &
318
                                   "INPUT PARAMETER");
319
               END IF;
320
 
321
               RETURN (NULL);
322
          END F ;
323
 
324
          FUNCTION NEW_F IS NEW F (ITEM        => DATE,
325
                                   ACCESS_ITEM => DATE_ACCESS) ;
326
 
327
     BEGIN  -- ACCESS_TO_FUNCS
328
          DATE_POINTER := NULL ;
329
          NEXT_DATE    := NEW_F(F_IN => DATE_POINTER) ;
330
     END ACCESS_TO_FUNCS ;
331
 
332
     --------------------------------------------------
333
 
334
     REPORT.RESULT;
335
 
336
END CC3017C;

powered by: WebSVN 2.1.0

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