| -- C64005C.ADA |
| |
| -- Grant of Unlimited Rights |
| -- |
| -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, |
| -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained |
| -- unlimited rights in the software and documentation contained herein. |
| -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making |
| -- this public release, the Government intends to confer upon all |
| -- recipients unlimited rights equal to those held by the Government. |
| -- These rights include rights to use, duplicate, release or disclose the |
| -- released technical data and computer software in whole or in part, in |
| -- any manner and for any purpose whatsoever, and to have or permit others |
| -- to do so. |
| -- |
| -- DISCLAIMER |
| -- |
| -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR |
| -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED |
| -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE |
| -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE |
| -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A |
| -- PARTICULAR PURPOSE OF SAID MATERIAL. |
| --* |
| -- CHECK THAT NESTED SUBPROGRAMS CAN BE CALLED RECURSIVELY AND THAT |
| -- NON-LOCAL VARIABLES AND FORMAL PARAMETERS ARE PROPERLY ACCESSED FROM |
| -- WITHIN RECURSIVE INVOCATIONS. THIS TEST CHECKS THAT EVERY DISPLAY OR |
| -- STATIC CHAIN LEVEL CAN BE ACCESSED. |
| |
| -- THIS TEST USES 3 LEVELS OF NESTED RECURSIVE PROCEDURES. |
| |
| -- JRK 7/26/84 |
| |
| WITH REPORT; USE REPORT; |
| |
| PROCEDURE C64005C IS |
| |
| SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C'; |
| SUBTYPE CALL IS CHARACTER RANGE '1' .. '3'; |
| |
| MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) - |
| LEVEL'POS (LEVEL'FIRST) + 1; |
| T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV + |
| MAX_LEV*(MAX_LEV+1)/2*2)) + 1; |
| G_LEN : CONSTANT := 2 + 4 * MAX_LEV; |
| |
| TYPE TRACE IS |
| RECORD |
| E : NATURAL := 0; |
| S : STRING (1 .. T_LEN); |
| END RECORD; |
| |
| V : CHARACTER := IDENT_CHAR ('<'); |
| L : CHARACTER := IDENT_CHAR ('>'); |
| T : TRACE; |
| G : STRING (1 .. G_LEN); |
| |
| PROCEDURE C64005CA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS |
| |
| V : STRING (1..2); |
| |
| M : CONSTANT NATURAL := LEVEL'POS (L) - |
| LEVEL'POS (LEVEL'FIRST) + 1; |
| N : CONSTANT NATURAL := 2 * M + 1; |
| |
| PROCEDURE C64005CB (L : LEVEL; C : CALL; T : IN OUT TRACE) IS |
| |
| V : STRING (1..2); |
| |
| M : CONSTANT NATURAL := LEVEL'POS (L) - |
| LEVEL'POS (LEVEL'FIRST) + 1; |
| N : CONSTANT NATURAL := 2 * M + 1; |
| |
| PROCEDURE C64005CC (L : LEVEL; C : CALL; |
| T : IN OUT TRACE) IS |
| |
| V : STRING (1..2); |
| |
| M : CONSTANT NATURAL := LEVEL'POS (L) - |
| LEVEL'POS (LEVEL'FIRST) + 1; |
| N : CONSTANT NATURAL := 2 * M + 1; |
| |
| BEGIN |
| |
| V (1) := IDENT_CHAR (ASCII.LC_C); |
| V (2) := C; |
| |
| -- APPEND ALL V TO T. |
| T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V & |
| C64005CB.V & C64005CC.V; |
| T.E := T.E + N; |
| |
| CASE C IS |
| |
| WHEN '1' => |
| C64005CA (IDENT_CHAR(LEVEL'FIRST), |
| IDENT_CHAR('2'), T); |
| |
| WHEN '2' => |
| C64005CC (L, IDENT_CHAR('3'), T); |
| |
| WHEN '3' => |
| -- APPEND MID-POINT SYMBOL TO T. |
| T.S (T.E+1) := IDENT_CHAR ('='); |
| T.E := T.E + 1; |
| |
| -- G := CATENATE ALL V, L, C; |
| G := C64005C.V & C64005C.L & |
| C64005CA.V & C64005CA.L & C64005CA.C & |
| C64005CB.V & C64005CB.L & C64005CB.C & |
| C64005CC.V & C64005CC.L & C64005CC.C; |
| END CASE; |
| |
| -- APPEND ALL L AND C TO T IN REVERSE ORDER. |
| T.S (T.E+1 .. T.E+N) := C64005CC.L & C64005CC.C & |
| C64005CB.L & C64005CB.C & |
| C64005CA.L & C64005CA.C & |
| C64005C.L; |
| T.E := T.E + N; |
| |
| END C64005CC; |
| |
| BEGIN |
| |
| V (1) := IDENT_CHAR (ASCII.LC_B); |
| V (2) := C; |
| |
| -- APPEND ALL V TO T. |
| T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V & |
| C64005CB.V; |
| T.E := T.E + N; |
| |
| CASE C IS |
| |
| WHEN '1' => |
| C64005CC (LEVEL'SUCC(L), IDENT_CHAR('1'), T); |
| |
| WHEN '2' => |
| C64005CB (L, IDENT_CHAR('3'), T); |
| |
| WHEN '3' => |
| C64005CC (LEVEL'SUCC(L), IDENT_CHAR('2'), T); |
| END CASE; |
| |
| -- APPEND ALL L AND C TO T IN REVERSE ORDER. |
| T.S (T.E+1 .. T.E+N) := C64005CB.L & C64005CB.C & |
| C64005CA.L & C64005CA.C & |
| C64005C.L; |
| T.E := T.E + N; |
| |
| END C64005CB; |
| |
| BEGIN |
| |
| V (1) := IDENT_CHAR (ASCII.LC_A); |
| V (2) := C; |
| |
| -- APPEND ALL V TO T. |
| T.S (T.E+1 .. T.E+N) := C64005C.V & C64005CA.V; |
| T.E := T.E + N; |
| |
| CASE C IS |
| |
| WHEN '1' => |
| C64005CB (LEVEL'SUCC(L), IDENT_CHAR('1'), T); |
| |
| WHEN '2' => |
| C64005CA (L, IDENT_CHAR('3'), T); |
| |
| WHEN '3' => |
| C64005CB (LEVEL'SUCC(L), IDENT_CHAR('2'), T); |
| END CASE; |
| |
| -- APPEND ALL L AND C TO T IN REVERSE ORDER. |
| T.S (T.E+1 .. T.E+N) := C64005CA.L & C64005CA.C & C64005C.L; |
| T.E := T.E + N; |
| |
| END C64005CA; |
| |
| BEGIN |
| TEST ("C64005C", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " & |
| "PARAMETERS AT ALL LEVELS OF NESTED " & |
| "RECURSIVE PROCEDURES ARE ACCESSIBLE"); |
| |
| -- APPEND V TO T. |
| T.S (T.E+1) := V; |
| T.E := T.E + 1; |
| |
| C64005CA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T); |
| |
| -- APPEND L TO T. |
| T.S (T.E+1) := L; |
| T.E := T.E + 1; |
| |
| COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E)); |
| COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E)); |
| COMMENT ("GLOBAL SNAPSHOT IS: " & G); |
| |
| -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY. |
| |
| DECLARE |
| SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A .. |
| CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1); |
| |
| CT : TRACE; |
| CG : STRING (1 .. G_LEN); |
| BEGIN |
| COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " & |
| INTEGER'IMAGE(T_LEN)); |
| |
| IF T.E /= IDENT_INT (T_LEN) THEN |
| FAILED ("WRONG FINAL CALL TRACE LENGTH"); |
| |
| ELSE CT.S (CT.E+1) := '<'; |
| CT.E := CT.E + 1; |
| |
| FOR I IN LC_LEVEL LOOP |
| CT.S (CT.E+1) := '<'; |
| CT.E := CT.E + 1; |
| |
| FOR J IN LC_LEVEL'FIRST .. I LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '1'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| END LOOP; |
| |
| FOR I IN LC_LEVEL LOOP |
| CT.S (CT.E+1) := '<'; |
| CT.E := CT.E + 1; |
| |
| FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '3'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| |
| CT.S (CT.E+1) := I; |
| CT.S (CT.E+2) := '2'; |
| CT.E := CT.E + 2; |
| |
| CT.S (CT.E+1) := '<'; |
| CT.E := CT.E + 1; |
| |
| FOR J IN LC_LEVEL'FIRST .. I LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '3'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| END LOOP; |
| |
| CT.S (CT.E+1) := '='; |
| CT.E := CT.E + 1; |
| |
| FOR I IN REVERSE LEVEL LOOP |
| FOR J IN REVERSE LEVEL'FIRST .. I LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '3'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| |
| CT.S (CT.E+1) := '>'; |
| CT.E := CT.E + 1; |
| |
| CT.S (CT.E+1) := I; |
| CT.S (CT.E+2) := '2'; |
| CT.E := CT.E + 2; |
| |
| FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '3'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| |
| CT.S (CT.E+1) := '>'; |
| CT.E := CT.E + 1; |
| END LOOP; |
| |
| FOR I IN REVERSE LEVEL LOOP |
| FOR J IN REVERSE LEVEL'FIRST .. I LOOP |
| CT.S (CT.E+1) := J; |
| CT.S (CT.E+2) := '1'; |
| CT.E := CT.E + 2; |
| END LOOP; |
| |
| CT.S (CT.E+1) := '>'; |
| CT.E := CT.E + 1; |
| END LOOP; |
| |
| CT.S (CT.E+1) := '>'; |
| CT.E := CT.E + 1; |
| |
| IF CT.E /= IDENT_INT (T_LEN) THEN |
| FAILED ("WRONG ITERATIVE TRACE LENGTH"); |
| |
| ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S); |
| |
| IF T.S /= CT.S THEN |
| FAILED ("WRONG FINAL CALL TRACE"); |
| END IF; |
| END IF; |
| END IF; |
| |
| DECLARE |
| E : NATURAL := 0; |
| BEGIN |
| CG (1..2) := "<>"; |
| E := E + 2; |
| |
| FOR I IN LEVEL LOOP |
| CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) - |
| LEVEL'POS(LEVEL'FIRST) + |
| LC_LEVEL'POS |
| (LC_LEVEL'FIRST)); |
| CG (E+2) := '3'; |
| CG (E+3) := I; |
| CG (E+4) := '3'; |
| E := E + 4; |
| END LOOP; |
| |
| COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG); |
| |
| IF G /= CG THEN |
| FAILED ("WRONG GLOBAL SNAPSHOT"); |
| END IF; |
| END; |
| END; |
| |
| RESULT; |
| END C64005C; |
