gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c8/c83030c.ada

   1 -- C83030C.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 -- OBJECTIVE:
  26 --     CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY COMPILED AS A SUBUNIT
  27 --     IN THE SAME COMPILATION, NON-HOMOGRAPH SUBPROGRAMS DECLARED
  28 --     OUTSIDE THE GENERIC UNIT, AND HAVING THE SAME IDENTIFIER, ARE NOT
  29 --     HIDDEN.
  30
  31 -- HISTORY:
  32 --     JET 10/17/88  CREATED ORIGINAL TEST.
  33 --     BCB 10/03/90  ADDED "PRAGMA ELABORATE (REPORT);".
  34
  35 WITH REPORT; USE REPORT;
  36 PRAGMA ELABORATE (REPORT);
  37 PACKAGE C83030C_DECL1 IS
  38      GLOBAL : INTEGER := IDENT_INT(INTEGER'FIRST);
  39      SWITCH : BOOLEAN := TRUE;
  40
  41      PROCEDURE C83030C_PROC1;
  42      PROCEDURE C83030C_PROC1 (X : INTEGER);
  43      PROCEDURE C83030C_PROC2;
  44      PROCEDURE C83030C_PROC2 (X : INTEGER);
  45      FUNCTION C83030C_FUNC3 RETURN INTEGER;
  46      FUNCTION C83030C_FUNC3 RETURN BOOLEAN;
  47      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER;
  48      FUNCTION C83030C_FUNC4 RETURN INTEGER;
  49      FUNCTION C83030C_FUNC4 RETURN BOOLEAN;
  50 END C83030C_DECL1;
  51
  52 WITH REPORT; USE REPORT;
  53 WITH C83030C_DECL1; USE C83030C_DECL1;
  54 PACKAGE C83030C_DECL2 IS
  55      GENERIC
  56      PROCEDURE C83030C_PROC1;
  57
  58      GENERIC
  59           TYPE T IS (<>);
  60      PROCEDURE C83030C_PROC2 (X : T);
  61
  62      GENERIC
  63      FUNCTION C83030C_FUNC3 RETURN INTEGER;
  64
  65      GENERIC
  66           TYPE T IS (<>);
  67      FUNCTION C83030C_FUNC4 RETURN T;
  68 END C83030C_DECL2;
  69
  70 WITH REPORT; USE REPORT;
  71 PACKAGE BODY C83030C_DECL1 IS
  72      PROCEDURE C83030C_PROC1 IS
  73      BEGIN
  74           GLOBAL := IDENT_INT(1);
  75      END C83030C_PROC1;
  76
  77      PROCEDURE C83030C_PROC1 (X : INTEGER) IS
  78      BEGIN
  79           GLOBAL := IDENT_INT(X);
  80      END C83030C_PROC1;
  81
  82      PROCEDURE C83030C_PROC2 IS
  83      BEGIN
  84           GLOBAL := IDENT_INT(1);
  85      END C83030C_PROC2;
  86
  87      PROCEDURE C83030C_PROC2 (X : INTEGER) IS
  88      BEGIN
  89           GLOBAL := IDENT_INT(X);
  90      END C83030C_PROC2;
  91
  92      FUNCTION C83030C_FUNC3 RETURN INTEGER IS
  93      BEGIN
  94           RETURN IDENT_INT(1);
  95      END C83030C_FUNC3;
  96
  97      FUNCTION C83030C_FUNC3 RETURN BOOLEAN IS
  98      BEGIN
  99           RETURN IDENT_BOOL(FALSE);
 100      END C83030C_FUNC3;
 101
 102      FUNCTION C83030C_FUNC3 (X : INTEGER) RETURN INTEGER IS
 103      BEGIN
 104           RETURN IDENT_INT(X);
 105      END C83030C_FUNC3;
 106
 107      FUNCTION C83030C_FUNC4 RETURN INTEGER IS
 108      BEGIN
 109           RETURN IDENT_INT(1);
 110      END C83030C_FUNC4;
 111
 112      FUNCTION C83030C_FUNC4 RETURN BOOLEAN IS
 113      BEGIN
 114           RETURN IDENT_BOOL(FALSE);
 115      END C83030C_FUNC4;
 116 END C83030C_DECL1;
 117
 118 WITH REPORT; USE REPORT;
 119 WITH C83030C_DECL1; USE C83030C_DECL1;
 120 PACKAGE BODY C83030C_DECL2 IS
 121      PROCEDURE C83030C_PROC1 IS SEPARATE;
 122      PROCEDURE C83030C_PROC2 (X : T) IS SEPARATE;
 123      FUNCTION C83030C_FUNC3 RETURN INTEGER IS SEPARATE;
 124      FUNCTION C83030C_FUNC4 RETURN T IS SEPARATE;
 125 END C83030C_DECL2;
 126
 127 SEPARATE (C83030C_DECL2)
 128 PROCEDURE C83030C_PROC1 IS
 129      A : INTEGER := IDENT_INT(2);
 130 BEGIN
 131      IF SWITCH THEN
 132           SWITCH := FALSE;
 133           C83030C_PROC1;
 134           IF GLOBAL /= IDENT_INT(3) THEN
 135                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 1");
 136           END IF;
 137      END IF;
 138      C83030C_PROC1(A);
 139      IF GLOBAL /= IDENT_INT(2) THEN
 140           FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 2");
 141      END IF;
 142      GLOBAL := IDENT_INT(3);
 143 END C83030C_PROC1;
 144
 145 SEPARATE (C83030C_DECL2)
 146 PROCEDURE C83030C_PROC2 (X : T) IS
 147      A : T := T'FIRST;
 148 BEGIN
 149      IF SWITCH THEN
 150           SWITCH := FALSE;
 151           C83030C_PROC2 (X);
 152           IF GLOBAL /= IDENT_INT(2) THEN
 153                FAILED ("INCORRECT VALUE FOR PROCEDURE CALL - 20");
 154           END IF;
 155           GLOBAL := IDENT_INT(3);
 156      ELSE
 157           GLOBAL := IDENT_INT(2);
 158      END IF;
 159 END C83030C_PROC2;
 160
 161 SEPARATE (C83030C_DECL2)
 162 FUNCTION C83030C_FUNC3 RETURN INTEGER IS
 163      A : INTEGER := INTEGER'LAST;
 164 BEGIN
 165      IF SWITCH THEN
 166           SWITCH := FALSE;
 167           IF C83030C_FUNC3 /= IDENT_INT(3) THEN
 168                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 30");
 169           END IF;
 170      END IF;
 171      IF C83030C_FUNC3(A) /= IDENT_INT(INTEGER'LAST) THEN
 172           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 31");
 173      END IF;
 174      IF C83030C_FUNC3 THEN
 175           FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 32");
 176      END IF;
 177      RETURN IDENT_INT(3);
 178 END C83030C_FUNC3;
 179
 180 SEPARATE (C83030C_DECL2)
 181 FUNCTION C83030C_FUNC4 RETURN T IS
 182      A : T := T'LAST;
 183 BEGIN
 184      IF SWITCH THEN
 185           SWITCH := FALSE;
 186           IF C83030C_FUNC4 /= T'LAST THEN
 187                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 40");
 188           END IF;
 189           RETURN T'FIRST;
 190      ELSE
 191           IF C83030C_FUNC4 THEN
 192                FAILED ("INCORRECT VALUE FROM FUNCTION CALL - 41");
 193           END IF;
 194           RETURN T'LAST;
 195      END IF;
 196 END C83030C_FUNC4;
 197
 198 WITH REPORT; USE REPORT;
 199 WITH C83030C_DECL1, C83030C_DECL2; USE C83030C_DECL1, C83030C_DECL2;
 200 PROCEDURE C83030C IS
 201 BEGIN
 202      TEST ("C83030C", "CHECK THAT WITHIN A GENERIC SUBPROGRAM BODY " &
 203                       "COMPILED AS A SUBUNIT IN THE SAME COMPILATION," &
 204                       " NON-HOMOGRAPH SUBPROGRAMS DECLARED OUTSIDE " &
 205                       "THE GENERIC UNIT, AND HAVING THE SAME " &
 206                       "IDENTIFIER, ARE NOT HIDDEN");
 207
 208      ONE:
 209      DECLARE
 210           PROCEDURE PROC1 IS NEW C83030C_DECL2.C83030C_PROC1;
 211      BEGIN
 212           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
 213                FAILED ("INCORRECT VALUE FOR START OF TEST ONE");
 214           END IF;
 215           PROC1;
 216           IF GLOBAL /= IDENT_INT(3) THEN
 217                FAILED ("INCORRECT VALUE FOR END OF TEST ONE");
 218           END IF;
 219
 220           GLOBAL := IDENT_INT(INTEGER'FIRST);
 221           SWITCH := TRUE;
 222      END ONE;
 223
 224      TWO:
 225      DECLARE
 226           PROCEDURE PROC2 IS NEW C83030C_DECL2.C83030C_PROC2(INTEGER);
 227      BEGIN
 228           IF GLOBAL /= IDENT_INT(INTEGER'FIRST) THEN
 229                FAILED ("INCORRECT VALUE FOR START OF TEST TWO");
 230           END IF;
 231           PROC2 (1);
 232           IF GLOBAL /= IDENT_INT(3) THEN
 233                FAILED ("INCORRECT VALUE FOR END OF TEST TWO");
 234           END IF;
 235
 236           SWITCH := TRUE;
 237      END TWO;
 238
 239      THREE:
 240      DECLARE
 241           FUNCTION FUNC3 IS NEW C83030C_DECL2.C83030C_FUNC3;
 242      BEGIN
 243           IF FUNC3 /= IDENT_INT(3) THEN
 244                FAILED ("INCORRECT VALUE FOR END OF TEST THREE");
 245           END IF;
 246
 247           SWITCH := TRUE;
 248      END THREE;
 249
 250      FOUR:
 251      DECLARE
 252           FUNCTION FUNC4 IS NEW C83030C_DECL2.C83030C_FUNC4 (INTEGER);
 253      BEGIN
 254           IF FUNC4 /= IDENT_INT(INTEGER'FIRST) THEN
 255                FAILED ("INCORRECT VALUE FOR END OF TEST FOUR");
 256           END IF;
 257
 258           GLOBAL := INTEGER'FIRST;
 259           SWITCH := TRUE;
 260      END FOUR;
 261
 262      RESULT;
 263 END C83030C;