gcc/testsuite/ada/acats/tests/a/a83009a.ada

   1 -- A83009A.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 DERIVED TYPE DECLARATION AND A GENERIC
  27 --     INSTANTIATION MAY DERIVE TWO OR MORE SUBPROGRAM HOMOGRAPHS.
  28 --     CHECK THE CASES WHERE:
  29 --          1) THE DERIVED SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF THE
  30 --             SUBSTITUTION OF THE DERIVED TYPE FOR THE PARENT TYPE IN
  31 --             THE IMPLICIT SUBPROGRAM SPECIFICATIONS.
  32 --          2) THE PARENT TYPE IS DECLARED IN A GENERIC INSTANCE AND
  33 --             THE INSTANCE INCLUDES TWO OR MORE DERIVABLE SUBPROGRAMS
  34 --             THAT ARE HOMOGRAPHS AS A RESULT OF THE ARGUMENTS GIVEN
  35 --             FOR THE GENERIC FORMAL-TYPE PARAMETERS.
  36 --     TEST CASES WHERE THE DERIVED TYPE DECLARATIONS AND GENERIC
  37 --     INSTANTIATIONS ARE GIVEN IN:
  38 --          . THE VISIBLE PART OF A PACKAGE SPECIFICATION,
  39 --          . THE PRIVATE PART OF A PACKAGE SPECIFICATION,
  40 --          . A PACKAGE BODY,
  41 --          . A SUBPROGRAM BODY,
  42 --          . A BLOCK STATEMENT.
  43 --
  44 -- HISTORY:
  45 --     VCL  03-08-88  CREATED ORIGINAL TEST.
  46
  47 WITH REPORT; USE REPORT;
  48 PROCEDURE A83009A IS
  49      TYPE ENUM IS (E1, E2, E3);
  50
  51      GENERIC
  52           TYPE T1 IS (<>);
  53           TYPE T2 IS (<>);
  54      PACKAGE G_PACK IS
  55           TYPE PARENT IS (E1, E2, E3);
  56
  57           PROCEDURE HP (P1 : PARENT; P2 : T1);
  58           PROCEDURE HP (P3 : PARENT; P4 : T2);
  59
  60           FUNCTION HF (P1 : T1) RETURN PARENT;
  61           FUNCTION HF (P2 : T2) RETURN PARENT;
  62      END G_PACK;
  63
  64      PACKAGE BODY G_PACK IS
  65           PROCEDURE HP (P1 : PARENT; P2 : T1) IS
  66           BEGIN
  67                NULL;
  68           END HP;
  69
  70           PROCEDURE HP (P3 : PARENT; P4 : T2) IS
  71           BEGIN
  72                NULL;
  73           END HP;
  74
  75           FUNCTION HF (P1 : T1) RETURN PARENT IS
  76           BEGIN
  77                RETURN E1;
  78           END HF;
  79
  80           FUNCTION HF (P2 : T2) RETURN PARENT IS
  81           BEGIN
  82                RETURN E2;
  83           END HF;
  84      END G_PACK;
  85 BEGIN
  86      TEST ("A83009A", "A DERIVED TYPE DECLARATION AND A GENERIC " &
  87                       "INSTANTIATION MAY DERIVE TWO OR " &
  88                       "MORE SUBPROGRAM HOMOGRAPHS");
  89
  90      DECLARE
  91      -- SUBPROGRAMS BECOME HOMOGRAPHS BECAUSE OF SUBSTITUTION.
  92
  93           PACKAGE PACK2 IS
  94                TYPE CHILD1 IS PRIVATE;
  95
  96                PACKAGE IN_PACK2 IS
  97                     TYPE PARENT IS (E1, E2, E3);
  98                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1);
  99                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT);
 100
 101                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
 102                                 RETURN PARENT;
 103                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
 104                                 RETURN PARENT;
 105                END IN_PACK2;
 106           PRIVATE
 107                TYPE CHILD1 IS NEW IN_PACK2.PARENT;
 108           END PACK2;
 109
 110           PACKAGE BODY PACK2 IS
 111                TYPE CHILD2 IS NEW CHILD1;
 112
 113                PACKAGE IN_BODY IS
 114                     TYPE CHILD3 IS NEW CHILD1;
 115                END IN_BODY;
 116
 117                PROCEDURE P IS
 118                     TYPE CHILD4 IS NEW CHILD1;
 119                BEGIN
 120                     NULL;
 121                END;
 122
 123                PACKAGE BODY IN_PACK2 IS
 124                     PROCEDURE HP (P1 : PARENT; P2 : CHILD1) IS
 125                     BEGIN
 126                          NULL;
 127                     END HP;
 128
 129                     PROCEDURE HP (P3 : CHILD1; P4 : PARENT) IS
 130                     BEGIN
 131                          NULL;
 132                     END HP;
 133
 134                     FUNCTION HF (P1 : CHILD1; P2 : PARENT)
 135                                 RETURN PARENT IS
 136                     BEGIN
 137                          RETURN E1;
 138                     END HF;
 139
 140                     FUNCTION HF (P3 : PARENT; P4 : CHILD1)
 141                                 RETURN PARENT IS
 142                     BEGIN
 143                          RETURN E2;
 144                     END HF;
 145                END IN_PACK2;
 146           BEGIN
 147                DECLARE
 148                     TYPE CHILD5 IS NEW CHILD1;
 149                BEGIN
 150                     NULL;
 151                END;
 152           END PACK2;
 153      BEGIN
 154           NULL;
 155      END;
 156
 157      DECLARE
 158      -- PARENT TYPE IN GENERIC INSTANCE HAS DERIVABLE HOMOGRAPHS.
 159
 160           PACKAGE INSTANCE1 IS
 161                NEW G_PACK (BOOLEAN, BOOLEAN);
 162
 163           TYPE CHILD1 IS NEW INSTANCE1.PARENT;
 164
 165           PACKAGE PACK1 IS
 166                PACKAGE INSTANCE2 IS
 167                     NEW G_PACK (CHARACTER, CHARACTER);
 168
 169                TYPE CHILD2 IS NEW INSTANCE2.PARENT;
 170                TYPE CHILD3 IS PRIVATE;
 171           PRIVATE
 172                PACKAGE INSTANCE3 IS
 173                     NEW G_PACK (ENUM, ENUM);
 174
 175                TYPE CHILD3 IS NEW INSTANCE3.PARENT;
 176           END PACK1;
 177
 178           PROCEDURE P1 IS
 179                PACKAGE INSTANCE4 IS
 180                     NEW G_PACK (BOOLEAN, BOOLEAN);
 181
 182                TYPE CHILD4 IS NEW INSTANCE4.PARENT;
 183           BEGIN
 184                NULL;
 185           END P1;
 186
 187           PACKAGE BODY PACK1 IS
 188                PACKAGE INSTANCE5 IS
 189                     NEW G_PACK (ENUM, ENUM);
 190
 191                TYPE CHILD5 IS NEW INSTANCE5.PARENT;
 192           END PACK1;
 193      BEGIN
 194           NULL;
 195      END;
 196
 197      RESULT;
 198 END A83009A;