WITH REPORT; USE REPORT;
PROCEDURE C64005D0M 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 C64005DA (L : LEVEL; C : CALL; T : IN OUT TRACE) IS
SEPARATE;
BEGIN
TEST ("C64005D", "CHECK THAT NON-LOCAL VARIABLES AND FORMAL " &
"PARAMETERS AT ALL LEVELS OF NESTED " &
"RECURSIVE PROCEDURES ARE ACCESSIBLE (FOR " &
"3 LEVELS OF SEPARATELY COMPILED SUBUNITS)");
T.S (T.E+1) := V;
T.E := T.E + 1;
C64005DA (IDENT_CHAR(LEVEL'FIRST), IDENT_CHAR('1'), 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);
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 C64005D0M;