gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c6/c64005b.ada

   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
  31 WITH REPORT;  USE REPORT;
  32 PROCEDURE 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
  76 BEGIN
  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
  98 EXCEPTION
  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
 109 END C64005B;