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

   1 -- C83024A.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 A DECLARATIVE REGION FOR A GENERIC
  27 --     PACKAGE 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 --     HOMOGRAH DECLARATION.
  32
  33 -- HISTORY:
  34 --     BCB 08/30/88  CREATED ORIGINAL TEST.
  35
  36 WITH REPORT; USE REPORT;
  37
  38 PROCEDURE C83024A 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 ("C83024A", "CHECK THAT A DECLARATION IN A DECLARATIVE " &
  52                       "REGION FOR A GENERIC PACKAGE HIDES AN OUTER " &
  53                       "DECLARATION OF A HOMOGRAPH");
  54
  55      ONE:
  56      DECLARE
  57           A : INTEGER := IDENT_INT(2);
  58           B : INTEGER := A;
  59           OBJ : INTEGER := IDENT_INT(3);
  60
  61           GENERIC
  62                X : IN INTEGER := A;
  63                A : IN OUT INTEGER;
  64           PACKAGE INNER IS
  65                C : INTEGER := A;
  66           END INNER;
  67
  68           PACKAGE BODY INNER IS
  69           BEGIN
  70                IF A /= IDENT_INT(3) THEN
  71                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 10");
  72                END IF;
  73
  74                IF ONE.A /= IDENT_INT(2) THEN
  75                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 11");
  76                END IF;
  77
  78                IF ONE.B /= IDENT_INT(2) THEN
  79                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 12");
  80                END IF;
  81
  82                IF C /= IDENT_INT(3) THEN
  83                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 13");
  84                END IF;
  85
  86                IF X /= IDENT_INT(2) THEN
  87                     FAILED ("INCORRECT VALUE PASSED IN - 14");
  88                END IF;
  89
  90                IF EQUAL(1,1) THEN
  91                     A := IDENT_INT(4);
  92                ELSE
  93                     A := 1;
  94                END IF;
  95           END INNER;
  96
  97           PACKAGE NEW_INNER IS NEW INNER (A => OBJ);
  98
  99      BEGIN  -- ONE
 100           IF OBJ /= IDENT_INT(4) THEN
 101                FAILED ("INCORRECT VALUE PASSED OUT - 15");
 102           END IF;
 103      END ONE;
 104
 105      TWO:
 106      DECLARE            -- AFTER THE SPECIFICATION OF PACKAGE.
 107           A : INTEGER := IDENT_INT(2);
 108
 109           GENERIC
 110                X : IN OUT INTEGER;
 111           PACKAGE INNER IS
 112                A : INTEGER := IDENT_INT(3);
 113           END INNER;
 114
 115           B : INTEGER := A;
 116
 117           PACKAGE BODY INNER IS
 118                C : INTEGER := TWO.A;
 119           BEGIN
 120                IF A /= IDENT_INT(3) THEN
 121                     FAILED ("INCORRECT VALUE FOR INNER HOMOGRAPH - 20");
 122                END IF;
 123
 124                IF TWO.A /= IDENT_INT(2) THEN
 125                     FAILED ("INCORRECT VALUE FOR OUTER HOMOGRAPH - 21");
 126                END IF;
 127
 128                IF TWO.B /= IDENT_INT(2) THEN
 129                     FAILED ("INCORRECT VALUE FOR OUTER VARIABLE - 22");
 130                END IF;
 131
 132                IF C /= IDENT_INT(2) THEN
 133                     FAILED ("INCORRECT VALUE FOR INNER VARIABLE - 23");
 134                END IF;
 135
 136                IF X /= IDENT_INT(2) THEN
 137                     FAILED ("INCORRECT VALUE PASSED IN - 24");
 138                END IF;
 139
 140                IF EQUAL(1,1) THEN
 141                     X := A;
 142                ELSE
 143                     NULL;
 144                END IF;
 145           END INNER;
 146
 147           PACKAGE NEW_INNER IS NEW INNER (A);
 148
 149      BEGIN  -- TWO
 150           IF A /= IDENT_INT(3) THEN
 151                FAILED ("INCORRECT VALUE PASSED OUT - 25");
 152           END IF;
 153      END TWO;
 154
 155      THREE:
 156      DECLARE                 --  OVERLOADING OF FUNCTIONS.
 157
 158           OBJ : INTEGER := 1;
 159           FLO : FLOAT := 6.25;
 160
 161           FUNCTION F IS NEW GEN_FUN (INTEGER, OBJ);
 162
 163           GENERIC
 164                X : IN OUT INTEGER;
 165                F : IN FLOAT;
 166           PACKAGE INNER IS
 167           END INNER;
 168
 169           FUNCTION F IS NEW GEN_FUN (FLOAT, FLO);
 170
 171           PACKAGE BODY INNER IS
 172           BEGIN
 173                X := INTEGER(F);
 174           END INNER;
 175
 176           PACKAGE NEW_INNER IS NEW INNER (OBJ, FLO);
 177
 178      BEGIN
 179           IF OBJ /= IDENT_INT(6) THEN
 180                FAILED ("INCORRECT VALUE RETURNED FROM FUNCTION - 60");
 181           END IF;
 182      END THREE;
 183
 184      RESULT;
 185 END C83024A;