gcc/testsuite/ada/acats/tests/c3/c39006e.ada

   1 -- C39006E.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 PROGRAM_ERROR IS NOT RAISED IF A SUBPROGRAM'S BODY HAS
  26 -- BEEN ELABORATED BEFORE IT IS CALLED. CHECK THE FOLLOWING:
  27 --     A) A SUBPROGRAM CAN APPEAR IN A NON-ELABORATED DECLARATIVE PART
  28 --        OR PACKAGE SPECIFICATION BEFORE ITS BODY.
  29
  30 -- TBN  8/21/86
  31
  32 WITH REPORT; USE REPORT;
  33 PROCEDURE C39006E IS
  34
  35 BEGIN
  36      TEST ("C39006E", "CHECK THAT PROGRAM_ERROR IS NOT RAISED IF A " &
  37                       "SUBPROGRAM IS CALLED IN A NON-ELABORATED " &
  38                       "DECLARATIVE PART OR PACKAGE SPECIFICATION " &
  39                       "BEFORE ITS BODY IS ELABORATED");
  40      DECLARE -- (A)
  41
  42           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER;
  43
  44           PACKAGE P IS
  45                PROCEDURE USE_INIT1;
  46           END P;
  47
  48           PACKAGE BODY P IS
  49                PROCEDURE USE_INIT1 IS
  50                BEGIN
  51                     IF NOT EQUAL (3, 3) THEN
  52                          DECLARE
  53                               X : INTEGER := INIT_1 (1);
  54                          BEGIN
  55                               NULL;
  56                          END;
  57                     ELSE
  58                          NULL;
  59                     END IF;
  60
  61                EXCEPTION
  62                     WHEN PROGRAM_ERROR =>
  63                          FAILED ("PROGRAM_ERROR RAISED - 1");
  64                     WHEN OTHERS =>
  65                          FAILED ("UNEXPECTED EXCEPTION RAISED - 1");
  66                END USE_INIT1;
  67
  68           BEGIN
  69                USE_INIT1;
  70           END P;
  71
  72           FUNCTION INIT_1 (A : INTEGER) RETURN INTEGER IS
  73           BEGIN
  74                RETURN (A + IDENT_INT(1));
  75           END INIT_1;
  76
  77      BEGIN -- (A)
  78           NULL;
  79      END; -- (A)
  80
  81      DECLARE -- (B)
  82
  83           PROCEDURE INIT_2 (A : IN OUT INTEGER);
  84
  85           PACKAGE P IS
  86                FUNCTION USE_INIT2 RETURN BOOLEAN;
  87           END P;
  88
  89           PACKAGE BODY P IS
  90                FUNCTION USE_INIT2 RETURN BOOLEAN IS
  91                BEGIN
  92                     IF NOT EQUAL (3, 3) THEN
  93                          DECLARE
  94                               X : INTEGER;
  95                          BEGIN
  96                               INIT_2 (X);
  97                          END;
  98                     END IF;
  99                     RETURN IDENT_BOOL (FALSE);
 100
 101                EXCEPTION
 102                     WHEN PROGRAM_ERROR =>
 103                          FAILED ("PROGRAM_ERROR RAISED - 2");
 104                          RETURN FALSE;
 105                     WHEN OTHERS =>
 106                          FAILED ("UNEXPECTED EXCEPTION RAISED - 2");
 107                          RETURN FALSE;
 108                END USE_INIT2;
 109           BEGIN
 110                IF USE_INIT2 THEN
 111                     FAILED ("INCORRECT RESULTS FROM FUNCTION CALL - 2");
 112                END IF;
 113           END P;
 114
 115           PROCEDURE INIT_2 (A : IN OUT INTEGER) IS
 116           BEGIN
 117                A := A + IDENT_INT(1);
 118           END INIT_2;
 119
 120      BEGIN -- (B)
 121           NULL;
 122      END; -- (B)
 123
 124      DECLARE -- (C)
 125           FUNCTION INIT_3 RETURN INTEGER;
 126
 127           PACKAGE Q IS
 128                VAR : INTEGER;
 129           END Q;
 130
 131           PACKAGE BODY Q IS
 132           BEGIN
 133                IF NOT EQUAL (3, 3) THEN
 134                     VAR := INIT_3;
 135                END IF;
 136           EXCEPTION
 137                WHEN PROGRAM_ERROR =>
 138                     FAILED ("PROGRAM_ERROR RAISED - 3");
 139                WHEN OTHERS =>
 140                     FAILED ("UNEXPECTED EXCEPTION RAISED - 3");
 141           END Q;
 142
 143           FUNCTION INIT_3 RETURN INTEGER IS
 144           BEGIN
 145                RETURN IDENT_INT (1);
 146           END INIT_3;
 147
 148      BEGIN -- (C)
 149           NULL;
 150      END; -- (C)
 151
 152      DECLARE -- (D)
 153           PROCEDURE INIT_4 (A : IN OUT INTEGER);
 154
 155           PACKAGE Q IS
 156                VAR : INTEGER := 1;
 157           END Q;
 158
 159           PACKAGE BODY Q IS
 160           BEGIN
 161                IF NOT EQUAL (3, 3) THEN
 162                     INIT_4 (VAR);
 163                END IF;
 164           EXCEPTION
 165                WHEN PROGRAM_ERROR =>
 166                     FAILED ("PROGRAM_ERROR RAISED - 4");
 167                WHEN OTHERS =>
 168                     FAILED ("UNEXPECTED EXCEPTION RAISED - 4");
 169           END Q;
 170
 171           PROCEDURE INIT_4 (A : IN OUT INTEGER) IS
 172           BEGIN
 173                A := IDENT_INT (4);
 174           END INIT_4;
 175
 176      BEGIN -- (D)
 177           NULL;
 178      END; -- (D)
 179
 180      BEGIN -- (E)
 181
 182           DECLARE
 183                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER;
 184
 185                PROCEDURE USE_INIT5 IS
 186                     PACKAGE Q IS
 187                          X : INTEGER := INIT_5 (1);
 188                     END Q;
 189                     USE Q;
 190                BEGIN
 191                     X := IDENT_INT (5);
 192
 193                END USE_INIT5;
 194
 195                FUNCTION INIT_5 (A : INTEGER) RETURN INTEGER IS
 196                BEGIN
 197                     RETURN (A + IDENT_INT(1));
 198                END INIT_5;
 199
 200           BEGIN
 201                USE_INIT5;
 202           END;
 203
 204      EXCEPTION
 205           WHEN PROGRAM_ERROR =>
 206                FAILED ("PROGRAM_ERROR RAISED - 5");
 207           WHEN OTHERS =>
 208                FAILED ("UNEXPECTED EXCEPTION RAISED - 5");
 209
 210      END; -- (E)
 211
 212      RESULT;
 213 END C39006E;