1-- C64005D0M.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 (SEPARATELY 31-- COMPILED AS SUBUNITS). 32 33-- SEPARATE FILES ARE: 34-- C64005D0M THE MAIN PROCEDURE. 35-- C64005DA A RECURSIVE PROCEDURE SUBUNIT OF C64005D0M. 36-- C64005DB A RECURSIVE PROCEDURE SUBUNIT OF C64005DA. 37-- C64005DC A RECURSIVE PROCEDURE SUBUNIT OF C64005DB. 38 39-- JRK 7/30/84 40 41WITH REPORT; USE REPORT; 42 43PROCEDURE C64005D0M IS 44 45 SUBTYPE LEVEL IS CHARACTER RANGE 'A' .. 'C'; 46 SUBTYPE CALL IS CHARACTER RANGE '1' .. '3'; 47 48 MAX_LEV : CONSTANT := LEVEL'POS (LEVEL'LAST) - 49 LEVEL'POS (LEVEL'FIRST) + 1; 50 T_LEN : CONSTANT := 2 * (1 + 3 * (MAX_LEV + 51 MAX_LEV*(MAX_LEV+1)/2*2)) + 1; 52 G_LEN : CONSTANT := 2 + 4 * MAX_LEV; 53 54 TYPE TRACE IS 55 RECORD 56 E : NATURAL := 0; 57 S : STRING (1 .. T_LEN); 58 END RECORD; 59 60 V : CHARACTER := IDENT_CHAR ('<'); 61 L : CHARACTER := IDENT_CHAR ('>'); 62 T : TRACE; 63 G : STRING (1 .. G_LEN); 64 65 PROCEDURE C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS 66 SEPARATE; 67 68BEGIN 69 TEST ("C64005D", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " & 70 "PARAMETERS AT ALL LEVELS OF NESTED " & 71 "RECURSIVE PROCEDURES ARE ACCESSIBLE (FOR " & 72 "3 LEVELS OF SEPARATELY COMPILED SUBUNITS)"); 73 74 -- APPEND V TO T. 75 T.S (T.E+1) := V; 76 T.E := T.E + 1; 77 78 C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), T); 79 80 -- APPEND L TO T. 81 T.S (T.E+1) := L; 82 T.E := T.E + 1; 83 84 COMMENT ("FINAL CALL TRACE LENGTH IS: " & INTEGER'IMAGE(T.E)); 85 COMMENT ("FINAL CALL TRACE IS: " & T.S(1..T.E)); 86 COMMENT ("GLOBAL SNAPSHOT IS: " & G); 87 88 -- CHECK THAT T AND G ARE CORRECT BY COMPUTING THEM ITERATIVELY. 89 90 DECLARE 91 SUBTYPE LC_LEVEL IS CHARACTER RANGE ASCII.LC_A .. 92 CHARACTER'VAL (CHARACTER'POS(ASCII.LC_A) + MAX_LEV - 1); 93 94 CT : TRACE; 95 CG : STRING (1 .. G_LEN); 96 BEGIN 97 COMMENT ("CORRECT FINAL CALL TRACE LENGTH IS: " & 98 INTEGER'IMAGE(T_LEN)); 99 100 IF T.E /= IDENT_INT (T_LEN) THEN 101 FAILED ("WRONG FINAL CALL TRACE LENGTH"); 102 103 ELSE CT.S (CT.E+1) := '<'; 104 CT.E := CT.E + 1; 105 106 FOR I IN LC_LEVEL LOOP 107 CT.S (CT.E+1) := '<'; 108 CT.E := CT.E + 1; 109 110 FOR J IN LC_LEVEL'FIRST .. I LOOP 111 CT.S (CT.E+1) := J; 112 CT.S (CT.E+2) := '1'; 113 CT.E := CT.E + 2; 114 END LOOP; 115 END LOOP; 116 117 FOR I IN LC_LEVEL LOOP 118 CT.S (CT.E+1) := '<'; 119 CT.E := CT.E + 1; 120 121 FOR J IN LC_LEVEL'FIRST .. LC_LEVEL'PRED(I) LOOP 122 CT.S (CT.E+1) := J; 123 CT.S (CT.E+2) := '3'; 124 CT.E := CT.E + 2; 125 END LOOP; 126 127 CT.S (CT.E+1) := I; 128 CT.S (CT.E+2) := '2'; 129 CT.E := CT.E + 2; 130 131 CT.S (CT.E+1) := '<'; 132 CT.E := CT.E + 1; 133 134 FOR J IN LC_LEVEL'FIRST .. I LOOP 135 CT.S (CT.E+1) := J; 136 CT.S (CT.E+2) := '3'; 137 CT.E := CT.E + 2; 138 END LOOP; 139 END LOOP; 140 141 CT.S (CT.E+1) := '='; 142 CT.E := CT.E + 1; 143 144 FOR I IN REVERSE LEVEL LOOP 145 FOR J IN REVERSE LEVEL'FIRST .. I LOOP 146 CT.S (CT.E+1) := J; 147 CT.S (CT.E+2) := '3'; 148 CT.E := CT.E + 2; 149 END LOOP; 150 151 CT.S (CT.E+1) := '>'; 152 CT.E := CT.E + 1; 153 154 CT.S (CT.E+1) := I; 155 CT.S (CT.E+2) := '2'; 156 CT.E := CT.E + 2; 157 158 FOR J IN REVERSE LEVEL'FIRST .. LEVEL'PRED(I) LOOP 159 CT.S (CT.E+1) := J; 160 CT.S (CT.E+2) := '3'; 161 CT.E := CT.E + 2; 162 END LOOP; 163 164 CT.S (CT.E+1) := '>'; 165 CT.E := CT.E + 1; 166 END LOOP; 167 168 FOR I IN REVERSE LEVEL LOOP 169 FOR J IN REVERSE LEVEL'FIRST .. I LOOP 170 CT.S (CT.E+1) := J; 171 CT.S (CT.E+2) := '1'; 172 CT.E := CT.E + 2; 173 END LOOP; 174 175 CT.S (CT.E+1) := '>'; 176 CT.E := CT.E + 1; 177 END LOOP; 178 179 CT.S (CT.E+1) := '>'; 180 CT.E := CT.E + 1; 181 182 IF CT.E /= IDENT_INT (T_LEN) THEN 183 FAILED ("WRONG ITERATIVE TRACE LENGTH"); 184 185 ELSE COMMENT ("CORRECT FINAL CALL TRACE IS: " & CT.S); 186 187 IF T.S /= CT.S THEN 188 FAILED ("WRONG FINAL CALL TRACE"); 189 END IF; 190 END IF; 191 END IF; 192 193 DECLARE 194 E : NATURAL := 0; 195 BEGIN 196 CG (1..2) := "<>"; 197 E := E + 2; 198 199 FOR I IN LEVEL LOOP 200 CG (E+1) := LC_LEVEL'VAL (LEVEL'POS(I) - 201 LEVEL'POS(LEVEL'FIRST) + 202 LC_LEVEL'POS 203 (LC_LEVEL'FIRST)); 204 CG (E+2) := '3'; 205 CG (E+3) := I; 206 CG (E+4) := '3'; 207 E := E + 4; 208 END LOOP; 209 210 COMMENT ("CORRECT GLOBAL SNAPSHOT IS: " & CG); 211 212 IF G /= CG THEN 213 FAILED ("WRONG GLOBAL SNAPSHOT"); 214 END IF; 215 END; 216 END; 217 218 RESULT; 219END C64005D0M; 220