1-- C64005B.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 A SUBPROGRAM CAN BE CALLED RECURSIVELY AND THAT NON-LOCAL
26-- VARIABLES AND CONSTANTS ARE PROPERLY ACCESSED FROM WITHIN RECURSIVE
27-- INVOCATIONS.
28
29-- CPP 7/2/84
30
31WITH REPORT;  USE REPORT;
32PROCEDURE C64005B IS
33
34     COUNT : INTEGER := 0;
35     TWENTY : CONSTANT INTEGER := 20;
36     C1 : CONSTANT INTEGER := 1;
37     G1, G2, G3 : INTEGER := 0;
38     G4, G5 : INTEGER := 0;
39
40     PROCEDURE R (A1 : INTEGER; A2 : IN OUT INTEGER; A3 : OUT INTEGER)
41     IS
42          C1 : CONSTANT INTEGER := 5;
43          TEN : CONSTANT INTEGER := 10;
44          J1, J2 : INTEGER := 1;
45          J3 : INTEGER := 0;
46
47          PROCEDURE RECURSE (P1 : INTEGER; P2 : IN OUT INTEGER) IS
48               C1 : INTEGER := 2;
49          BEGIN     -- RECURSE
50               C1 := IDENT_INT (10);
51               IF P1 < TWENTY THEN
52                    RECURSE (P1 + C1, G2);
53                    G1 := G1 + C64005B.C1;
54                    G3 := G3 + P1;
55                    P2 := P2 + IDENT_INT(2);
56                    A2 := A2 + IDENT_INT(1);
57                    J2 := J2 + R.C1;
58               END IF;
59          END RECURSE;
60
61     BEGIN     -- R
62          IF A2 < TEN THEN
63               A2 := A2 + C1;
64               RECURSE (0, J1);
65               J3 := J3 + TEN;
66               COUNT := COUNT + 1;
67               COMMENT ("ON PASS # " & INTEGER'IMAGE(COUNT));
68               COMMENT ("VALUE OF A2 IS " & INTEGER'IMAGE(A2));
69               COMMENT ("VALUE OF J3 IS " & INTEGER'IMAGE(J3));
70               R (0, A2, J3);
71               J3 := J3 + A2;
72          END IF;
73          A3 := J1 + J3;
74     END R;
75
76BEGIN
77     TEST("C64005B", "RECURSIVE SUBPROGRAMS WITH ALL KINDS " &
78          "OF DATA ACCESS");
79
80     R (0, G4, G5);
81
82     IF (COUNT /=  2) OR (G1 /=  4) OR
83        (G2    /=  4) OR (G3 /= 20) OR
84        (G4    /= 14) OR (G5 /= 35) THEN
85          FAILED ("RECURSIVE INVOCATIONS' DATA ACCESS IS NOT" &
86                  " WORKING CORRECTLY");
87     END IF;
88
89     COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
90     COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
91     COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
92     COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
93     COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
94     COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
95
96     RESULT;
97
98EXCEPTION
99     WHEN PROGRAM_ERROR =>
100          FAILED ("PROGRAM_ERROR RAISED");
101          COMMENT ("VALUE OF COUNT IS " & INTEGER'IMAGE(COUNT));
102          COMMENT ("VALUE OF G1 IS " & INTEGER'IMAGE(G1));
103          COMMENT ("VALUE OF G2 IS " & INTEGER'IMAGE(G2));
104          COMMENT ("VALUE OF G3 IS " & INTEGER'IMAGE(G3));
105          COMMENT ("VALUE OF G4 IS " & INTEGER'IMAGE(G4));
106          COMMENT ("VALUE OF G5 IS " & INTEGER'IMAGE(G5));
107          RESULT;
108
109END C64005B;
110