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/] [c6/] [c64005c.ada] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C64005C.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 NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT
26
-- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM
27
-- WITHIN RECURSIVE INVOCATIONS.  THIS TEST CHECKS THAT EVERY DISPLAY OR
28
-- STATIC CHAIN LEVEL CAN BE ACCESSED.
29
 
30
-- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES.
31
 
32
-- JRK 7/26/84
33
 
34
WITH REPORT; USE REPORT;
35
 
36
PROCEDURE C64005C IS
37
 
38
     SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C';
39
     SUBTYPE CALL IS CHARACTER RANGE '1' .. '3';
40
 
41
     MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) -
42
                           LEVEL'POS (LEVEL'FIRST) + 1;
43
     T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV +
44
                                       MAX_LEV*(MAX_LEV+1)/2*2)) + 1;
45
     G_LEN : CONSTANT := 2 + 4 * MAX_LEV;
46
 
47
     TYPE TRACE IS
48
          RECORD
49
               E : NATURAL := 0;
50
               S : STRING (1 .. T_LEN);
51
          END RECORD;
52
 
53
     V : CHARACTER := IDENT_CHAR ('<');
54
     L : CHARACTER := IDENT_CHAR ('>');
55
     T : TRACE;
56
     G : STRING (1 .. G_LEN);
57
 
58
     PROCEDURE C64005CA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
59
 
60
          V : STRING (1..2);
61
 
62
          M : CONSTANT NATURAL := LEVEL'POS (L) -
63
                                  LEVEL'POS (LEVEL'FIRST) + 1;
64
          N : CONSTANT NATURAL := 2 * M + 1;
65
 
66
          PROCEDURE C64005CB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
67
 
68
               V : STRING (1..2);
69
 
70
               M : CONSTANT NATURAL := LEVEL'POS (L) -
71
                                       LEVEL'POS (LEVEL'FIRST) + 1;
72
               N : CONSTANT NATURAL := 2 * M + 1;
73
 
74
               PROCEDURE C64005CC (L : LEVEL; C : CALL;
75
                                   T : IN OUT TRACE) IS
76
 
77
                    V : STRING (1..2);
78
 
79
                    M : CONSTANT NATURAL := LEVEL'POS (L) -
80
                                            LEVEL'POS (LEVEL'FIRST) + 1;
81
                    N : CONSTANT NATURAL := 2 * M + 1;
82
 
83
               BEGIN
84
 
85
                    V (1) := IDENT_CHAR (ASCII.LC_C);
86
                    V (2) := C;
87
 
88
                    -- APPEND ALL V TO T.
89
                    T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
90
                                            C64005CB.V & C64005CC.V;
91
                    T.E := T.E + N;
92
 
93
                    CASE C IS
94
 
95
                         WHEN '1' =>
96
                              C64005CA (IDENT_CHAR(LEVEL'FIRST),
97
                                        IDENT_CHAR('2'), T);
98
 
99
                         WHEN '2' =>
100
                              C64005CC (L, IDENT_CHAR('3'), T);
101
 
102
                         WHEN '3' =>
103
                              -- APPEND MID-POINT SYMBOL TO T.
104
                              T.S (T.E+1) := IDENT_CHAR ('=');
105
                              T.E := T.E + 1;
106
 
107
                              -- G := CATENATE ALL V, L, C;
108
                              G := C64005C.V & C64005C.L &
109
                                  C64005CA.V & C64005CA.L & C64005CA.C &
110
                                  C64005CB.V & C64005CB.L & C64005CB.C &
111
                                  C64005CC.V & C64005CC.L & C64005CC.C;
112
                    END CASE;
113
 
114
                    -- APPEND ALL L AND C TO T IN REVERSE ORDER.
115
                    T.S (T.E+1 .. T.E+N) := C64005CC.L & C64005CC.C &
116
                                            C64005CB.L & C64005CB.C &
117
                                            C64005CA.L & C64005CA.C &
118
                                            C64005C.L;
119
                    T.E := T.E + N;
120
 
121
               END C64005CC;
122
 
123
          BEGIN
124
 
125
               V (1) := IDENT_CHAR (ASCII.LC_B);
126
               V (2) := C;
127
 
128
               -- APPEND ALL V TO T.
129
               T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V &
130
                                       C64005CB.V;
131
               T.E := T.E + N;
132
 
133
               CASE C IS
134
 
135
                    WHEN '1' =>
136
                         C64005CC (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
137
 
138
                    WHEN '2' =>
139
                         C64005CB (L, IDENT_CHAR('3'), T);
140
 
141
                    WHEN '3' =>
142
                         C64005CC (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
143
               END CASE;
144
 
145
               -- APPEND ALL L AND C TO T IN REVERSE ORDER.
146
               T.S (T.E+1 .. T.E+N) := C64005CB.L & C64005CB.C &
147
                                       C64005CA.L & C64005CA.C &
148
                                       C64005C.L;
149
               T.E := T.E + N;
150
 
151
          END C64005CB;
152
 
153
     BEGIN
154
 
155
          V (1) := IDENT_CHAR (ASCII.LC_A);
156
          V (2) := C;
157
 
158
          -- APPEND ALL V TO T.
159
          T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V;
160
          T.E := T.E + N;
161
 
162
          CASE C IS
163
 
164
               WHEN '1' =>
165
                    C64005CB (LEVEL'SUCC(L), IDENT_CHAR('1'), T);
166
 
167
               WHEN '2' =>
168
                    C64005CA (L, IDENT_CHAR('3'), T);
169
 
170
               WHEN '3' =>
171
                    C64005CB (LEVEL'SUCC(L), IDENT_CHAR('2'), T);
172
          END CASE;
173
 
174
          -- APPEND ALL L AND C TO T IN REVERSE ORDER.
175
          T.S (T.E+1 .. T.E+N) := C64005CA.L & C64005CA.C & C64005C.L;
176
          T.E := T.E + N;
177
 
178
     END C64005CA;
179
 
180
BEGIN
181
     TEST ("C64005C", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
182
                      "PARAMETERS AT ALL LEVELS OF NESTED " &
183
                      "RECURSIVE PROCEDURES ARE ACCESSIBLE");
184
 
185
     -- APPEND V TO T.
186
     T.S (T.E+1) := V;
187
     T.E := T.E + 1;
188
 
189
     C64005CA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T);
190
 
191
     -- APPEND L TO T.
192
     T.S (T.E+1) := L;
193
     T.E := T.E + 1;
194
 
195
     COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E));
196
     COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E));
197
     COMMENT ("GLOBAL SNAPSHOT IS: " & G);
198
 
199
     -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY.
200
 
201
     DECLARE
202
          SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A ..
203
               CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1);
204
 
205
          CT : TRACE;
206
          CG : STRING (1 .. G_LEN);
207
     BEGIN
208
          COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " &
209
                   INTEGER'IMAGE(T_LEN));
210
 
211
          IF T.E /= IDENT_INT (T_LEN) THEN
212
               FAILED ("WRONG FINAL CALL TRACE LENGTH");
213
 
214
          ELSE CT.S (CT.E+1) := '<';
215
               CT.E := CT.E + 1;
216
 
217
               FOR I IN LC_LEVEL LOOP
218
                    CT.S (CT.E+1) := '<';
219
                    CT.E := CT.E + 1;
220
 
221
                    FOR J IN LC_LEVEL'FIRST .. I LOOP
222
                         CT.S (CT.E+1) := J;
223
                         CT.S (CT.E+2) := '1';
224
                         CT.E := CT.E + 2;
225
                    END LOOP;
226
               END LOOP;
227
 
228
               FOR I IN LC_LEVEL LOOP
229
                    CT.S (CT.E+1) := '<';
230
                    CT.E := CT.E + 1;
231
 
232
                    FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP
233
                         CT.S (CT.E+1) := J;
234
                         CT.S (CT.E+2) := '3';
235
                         CT.E := CT.E + 2;
236
                    END LOOP;
237
 
238
                    CT.S (CT.E+1) := I;
239
                    CT.S (CT.E+2) := '2';
240
                    CT.E := CT.E + 2;
241
 
242
                    CT.S (CT.E+1) := '<';
243
                    CT.E := CT.E + 1;
244
 
245
                    FOR J IN LC_LEVEL'FIRST .. I LOOP
246
                         CT.S (CT.E+1) := J;
247
                         CT.S (CT.E+2) := '3';
248
                         CT.E := CT.E + 2;
249
                    END LOOP;
250
               END LOOP;
251
 
252
               CT.S (CT.E+1) := '=';
253
               CT.E := CT.E + 1;
254
 
255
               FOR I IN REVERSE LEVEL LOOP
256
                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
257
                         CT.S (CT.E+1) := J;
258
                         CT.S (CT.E+2) := '3';
259
                         CT.E := CT.E + 2;
260
                    END LOOP;
261
 
262
                    CT.S (CT.E+1) := '>';
263
                    CT.E := CT.E + 1;
264
 
265
                    CT.S (CT.E+1) := I;
266
                    CT.S (CT.E+2) := '2';
267
                    CT.E := CT.E + 2;
268
 
269
                    FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP
270
                         CT.S (CT.E+1) := J;
271
                         CT.S (CT.E+2) := '3';
272
                         CT.E := CT.E + 2;
273
                    END LOOP;
274
 
275
                    CT.S (CT.E+1) := '>';
276
                    CT.E := CT.E + 1;
277
               END LOOP;
278
 
279
               FOR I IN REVERSE LEVEL LOOP
280
                    FOR J IN REVERSE LEVEL'FIRST .. I LOOP
281
                         CT.S (CT.E+1) := J;
282
                         CT.S (CT.E+2) := '1';
283
                         CT.E := CT.E + 2;
284
                    END LOOP;
285
 
286
                    CT.S (CT.E+1) := '>';
287
                    CT.E := CT.E + 1;
288
               END LOOP;
289
 
290
               CT.S (CT.E+1) := '>';
291
               CT.E := CT.E + 1;
292
 
293
               IF CT.E /= IDENT_INT (T_LEN) THEN
294
                    FAILED ("WRONG ITERATIVE TRACE LENGTH");
295
 
296
               ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S);
297
 
298
                    IF T.S /= CT.S THEN
299
                         FAILED ("WRONG FINAL CALL TRACE");
300
                    END IF;
301
               END IF;
302
          END IF;
303
 
304
          DECLARE
305
               E : NATURAL := 0;
306
          BEGIN
307
               CG (1..2) := "<>";
308
               E := E + 2;
309
 
310
               FOR I IN LEVEL LOOP
311
                    CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) -
312
                                              LEVEL'POS(LEVEL'FIRST) +
313
                                              LC_LEVEL'POS
314
                                                      (LC_LEVEL'FIRST));
315
                    CG (E+2) := '3';
316
                    CG (E+3) := I;
317
                    CG (E+4) := '3';
318
                    E := E + 4;
319
               END LOOP;
320
 
321
               COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG);
322
 
323
               IF G /= CG THEN
324
                    FAILED ("WRONG GLOBAL SNAPSHOT");
325
               END IF;
326
          END;
327
     END;
328
 
329
     RESULT;
330
END C64005C;

powered by: WebSVN 2.1.0

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