toolchain/gcc/gcc/testsuite/ada/acats/tests/c8/c83025a.ada

   1 -- C83025A.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 A DECLARATION IN THE DECLARATIVE REGION OF A GENERIC
  27 --     SUBPROGRAM HIDES AN OUTER DECLARATION OF A HOMOGRAPH. ALSO CHECK
  28 --     THAT THE OUTER DECLARATION IS DIRECTLY VISIBLE IN BOTH
  29 --     DECLARATIVE REGIONS BEFORE THE DECLARATION OF THE INNER HOMOGRAPH
  30 --     AND THE OUTER DECLARATION IS VISIBLE BY SELECTION AFTER THE INNER
  31 --     HOMOGRAPH DECLARATION.
  32
  33 -- HISTORY:
  34 --     BCB 08/31/88  CREATED ORIGINAL TEST.
  35
  36 WITH REPORT; USE REPORT;
  37
  38 PROCEDURE C83025A IS
  39
  40      GENERIC
  41           TYPE T IS PRIVATE;
  42           X : T;
  43      FUNCTION GEN_FUN RETURN T;
  44
  45      FUNCTION GEN_FUN RETURN T IS
  46      BEGIN
  47           RETURN X;
  48      END GEN_FUN;
  49
  50 BEGIN
  51      TEST ("C83025A", "CHECK THAT A DECLARATION IN THE DECLARATIVE " &
  52                       "REGION OF A GENERIC SUBPROGRAM HIDES AN OUTER " &
  53                       "DECLARATION OF A HOMOGRAPH");
  54
  55      ONE:
  56      DECLARE                      -- SUBPROGRAM DECLARATIVE REGION.
  57           A : INTEGER := IDENT_INT(2);
  58           B : INTEGER := A;
  59
  60           GENERIC
  61           PROCEDURE INNER (X : IN OUT INTEGER);
  62
  63           PROCEDURE INNER (X : IN OUT INTEGER) IS
  64                C : INTEGER := A;
  65                A : INTEGER := IDENT_INT(3);
  66           BEGIN
  67                IF A /= IDENT_INT(3) THEN
  68                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 1");
  69                END IF;
  70
  71                IF ONE.A /= IDENT_INT(2) THEN
  72                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 2");
  73                END IF;
  74
  75                IF ONE.B /= IDENT_INT(2) THEN
  76                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 3");
  77                END IF;
  78
  79                IF C /= IDENT_INT(2) THEN
  80                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 4");
  81                END IF;
  82
  83                IF X /= IDENT_INT(2) THEN
  84                     FAILED ("INCORRECT VALUE PASSED IN - 5");
  85                END IF;
  86
  87                IF EQUAL(1,1) THEN
  88                     X := A;
  89                ELSE
  90                     X := ONE.A;
  91                END IF;
  92           END INNER;
  93
  94           PROCEDURE NEW_INNER IS NEW INNER;
  95
  96      BEGIN  -- ONE
  97           NEW_INNER (A);
  98
  99           IF A /= IDENT_INT(3) THEN
 100                FAILED ("INCORRECT VALUE PASSED OUT - 6");
 101           END IF;
 102      END ONE;
 103
 104      TWO:
 105      DECLARE               -- FORMAL PARAMETER OF GENERIC SUBPROGRAM.
 106           A : INTEGER := IDENT_INT(2);
 107           B : INTEGER := A;
 108           OBJ : INTEGER := IDENT_INT(3);
 109
 110           GENERIC
 111           PROCEDURE INNER (X : IN INTEGER := A;
 112                            A : IN OUT INTEGER);
 113
 114           PROCEDURE INNER (X : IN INTEGER := TWO.A;
 115                            A : IN OUT INTEGER) IS
 116                C : INTEGER := A;
 117           BEGIN
 118                IF A /= IDENT_INT(3) THEN
 119                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH -10");
 120                END IF;
 121
 122                IF TWO.A /= IDENT_INT(2) THEN
 123                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
 124                END IF;
 125
 126                IF TWO.B /= IDENT_INT(2) THEN
 127                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
 128                END IF;
 129
 130                IF C /= IDENT_INT(3) THEN
 131                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
 132                END IF;
 133
 134                IF X /= IDENT_INT(2) THEN
 135                     FAILED ("INCORRECT VALUE PASSED IN - 14");
 136                END IF;
 137
 138                IF EQUAL(1,1) THEN
 139                     A := IDENT_INT(4);
 140                ELSE
 141                     A := 1;
 142                END IF;
 143           END INNER;
 144
 145           PROCEDURE NEW_INNER IS NEW INNER;
 146
 147      BEGIN  -- TWO
 148           NEW_INNER (A => OBJ);
 149
 150           IF OBJ /= IDENT_INT(4) THEN
 151                FAILED ("INCORRECT VALUE PASSED OUT - 15");
 152           END IF;
 153      END TWO;
 154
 155      THREE:
 156      DECLARE      -- AFTER THE SPECIFICATION OF GENERIC SUBPROGRAM.
 157           GENERIC
 158                A : INTEGER := IDENT_INT(3);
 159           FUNCTION INNER (X : INTEGER) RETURN INTEGER;
 160
 161           A : INTEGER := IDENT_INT(2);
 162
 163           B : INTEGER := A;
 164
 165           FUNCTION INNER (X : INTEGER) RETURN INTEGER IS
 166                C : INTEGER := THREE.A;
 167           BEGIN
 168                IF A /= IDENT_INT(3) THEN
 169                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
 170                END IF;
 171
 172                IF THREE.A /= IDENT_INT(2) THEN
 173                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
 174                END IF;
 175
 176                IF THREE.B /= IDENT_INT(2) THEN
 177                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
 178                END IF;
 179
 180                IF C /= IDENT_INT(2) THEN
 181                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
 182                END IF;
 183
 184                IF X /= IDENT_INT(2) THEN
 185                     FAILED ("INCORRECT VALUE PASSED IN - 24");
 186                END IF;
 187
 188                IF EQUAL(1,1) THEN
 189                     RETURN A;
 190                ELSE
 191                     RETURN X;
 192                END IF;
 193           END INNER;
 194
 195           FUNCTION NEW_INNER IS NEW INNER;
 196
 197      BEGIN  -- THREE
 198           IF NEW_INNER(A) /= IDENT_INT(3) THEN
 199                FAILED ("INCORRECT VALUE PASSED OUT - 25");
 200           END IF;
 201      END THREE;
 202
 203      FOUR:
 204      DECLARE
 205           A : INTEGER := IDENT_INT(2);
 206
 207           GENERIC
 208                A : INTEGER;
 209                B : INTEGER := A;
 210           PROCEDURE INNER (X : IN OUT INTEGER);
 211
 212           PROCEDURE INNER (X : IN OUT INTEGER) IS
 213                C : INTEGER := FOUR.A;
 214           BEGIN
 215                IF A /= IDENT_INT(3) THEN
 216                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 30");
 217                END IF;
 218
 219                IF B /= IDENT_INT(3) THEN
 220                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 31");
 221                END IF;
 222
 223                IF FOUR.A /= IDENT_INT(2) THEN
 224                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 32");
 225                END IF;
 226
 227                IF C /= IDENT_INT(2) THEN
 228                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 33");
 229                END IF;
 230
 231                IF X /= IDENT_INT(2) THEN
 232                     FAILED ("INCORRECT VALUE PASSED IN - 34");
 233                END IF;
 234
 235                IF EQUAL(1,1) THEN
 236                     X := A;
 237                ELSE
 238                     X := FOUR.A;
 239                END IF;
 240           END INNER;
 241
 242           PROCEDURE NEW_INNER IS NEW INNER (A => IDENT_INT(3));
 243
 244      BEGIN
 245           NEW_INNER (A);
 246
 247           IF A /= IDENT_INT(3) THEN
 248                FAILED ("INCORRECT VALUE PASSED OUT - 35");
 249           END IF;
 250      END FOUR;
 251
 252      FIVE:
 253      DECLARE                 --  OVERLOADING OF FUNCTIONS.
 254
 255           OBJ : INTEGER := 1;
 256           FLO : FLOAT := 5.0;
 257
 258           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
 259
 260           GENERIC
 261           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT);
 262
 263           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
 264
 265           PROCEDURE INNER (X : IN OUT INTEGER; F : IN FLOAT) IS
 266           BEGIN
 267                X := INTEGER(F);
 268           END INNER;
 269
 270           PROCEDURE NEW_INNER IS NEW INNER;
 271
 272      BEGIN  -- FIVE
 273           FLO := 6.25;
 274
 275           NEW_INNER (OBJ, FLO);
 276
 277           IF OBJ /= IDENT_INT(6) THEN
 278                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 40");
 279           END IF;
 280      END FIVE;
 281
 282      RESULT;
 283 END C83025A;