gcc/testsuite/ada/acats/tests/cc/cc3016f.ada

   1 -- CC3016F.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 --     OFFICE, 3E 114, THE PENTAGON, WASHINGTON DC 20301-3081.
  26
  27 -- OBJECTIVE:
  28 --   CHECK THAT AN INSTANTIATED PACKAGE HAS THE PROPERTIES REQUIRED
  29 --   OF A PACKAGE.
  30
  31 --   CHECK THAT IF THE PARENT TYPE IN A DERIVED TYPE DEFINITION IS
  32 --   A GENERIC FORMAL TYPE, THE OPERATIONS DECLARED FOR THE DERIVED
  33 --   TYPE IN THE TEMPLATE ARE DETERMINED BY THE DECLARATION OF THE
  34 --   FORMAL TYPE.  THE OPERATIONS DECLARED FOR DERIVED TYPE IN THE
  35 --   INSTANCE ARE DETERMINED BY THE ACTUAL TYPE DENOTED BY THE FORMAL
  36 --   PARAMETER.  SEE AI-00398.
  37
  38 -- HISTORY:
  39 --   DAS  8 OCT 90   INITIAL VERSION.
  40 --   JRL 02/19/93  ADDED USE CLAUSES FOR INSTANCES TO ENSURE DIRECT
  41 --                 OPERATOR VISIBILITY. CHANGED NT4'LAST TO P4.NT4'LAST
  42 --                 IN ASSIGNMENT STATEMENT FOR P4.X IN EXAMPLE_4.
  43 --                 CORRECTED ABE ERRORS IN EXAMPLE_2 AND EXAMPLE_3.
  44 --                 CHANGED R3."+" FROM MULTIPLICATION TO SUBTRACTION TO
  45 --                 AVOID CONSTRAINT_ERROR.
  46
  47 WITH REPORT;
  48
  49 PROCEDURE CC3016F IS
  50 BEGIN
  51      REPORT.TEST ("CC3016F", "CHECK THAT IF THE PARENT TYPE IN A " &
  52                              "DERIVED TYPE DEFINITION IS A GENERIC " &
  53                              "FORMAL TYPE, THE OPERATIONS DECLARED " &
  54                              "FOR THE DERIVED TYPE IN THE TEMPLATE " &
  55                              "ARE DETERMINED BY THE DECLARATION OF " &
  56                              "THE FORMAL TYPE, AND THAT THE " &
  57                              "OPERATIONS DECLARED FOR THE DERIVED " &
  58                              "TYPE IN THE INSTANCE ARE DETERMINED BY " &
  59                              "THE ACTUAL TYPE DENOTED BY THE FORMAL " &
  60                              "PARAMETER (AI-00398)");
  61 EXAMPLE_2:
  62      DECLARE
  63           GENERIC
  64                TYPE PRIV IS PRIVATE;
  65           PACKAGE GP2 IS
  66                TYPE NT2 IS NEW PRIV;
  67           END GP2;
  68
  69           PACKAGE R2 IS
  70                TYPE T2 IS RANGE 1..10;
  71                FUNCTION F RETURN T2;
  72           END R2;
  73
  74           PACKAGE P2 IS NEW GP2 (PRIV => R2.T2);
  75           USE P2;
  76
  77           XX1 : P2.NT2;
  78           XX2 : P2.NT2;
  79           XX3 : P2.NT2;
  80
  81           PACKAGE BODY R2 IS
  82                FUNCTION F RETURN T2 IS
  83                BEGIN
  84                     RETURN T2'LAST;
  85                END F;
  86           END R2;
  87      BEGIN
  88           XX1 := 5;                   -- IMPLICIT CONVERSION FROM
  89                                       -- UNIVERSAL INTEGER TO P2.NT2
  90                                       -- IN P2.
  91           XX2 := XX1 + XX1;           -- PREDEFINED "+" DECLARED FOR
  92                                       -- P2.NT2.
  93           XX3 := P2.F;                -- FUNCTION F DERIVED WITH THE
  94                                       -- INSTANCE.
  95
  96      END EXAMPLE_2;
  97
  98 EXAMPLE_3:
  99      DECLARE
 100           GENERIC
 101                TYPE T3 IS RANGE <>;
 102           PACKAGE GP3 IS
 103                TYPE NT3 IS NEW T3;
 104                X : NT3 := 5;
 105                Y : NT3 := X + 3;      -- USES PREDEFINED "+" EVEN IN
 106                                       -- INSTANCES
 107           END GP3;
 108
 109           PACKAGE R3 IS
 110                TYPE S IS RANGE 1..10;
 111                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S;
 112           END R3;
 113
 114           PACKAGE P3 IS NEW GP3 ( T3 => R3.S );
 115           USE P3;
 116
 117           Z : P3.NT3;
 118
 119           PACKAGE BODY R3 IS
 120                FUNCTION "+" (LEFT : IN S; RIGHT : IN S) RETURN S IS
 121                BEGIN  -- IMPLEMENT AS SUBTRACTION, NOT ADDITION
 122                     RETURN LEFT - RIGHT;
 123                END "+";
 124           END R3;
 125      BEGIN
 126           Z := P3.X + 3;     -- USES REDEFINED "+"
 127
 128           IF ( P3.Y /= P3.NT3'(8) ) THEN
 129                REPORT.FAILED ("PREDEFINED ""+"" NOT USED TO COMPUTE " &
 130                              "P3.Y");
 131           END IF;
 132
 133           IF (Z /= P3.NT3'(2) ) THEN
 134                REPORT.FAILED ("REDEFINED ""+"" NOT USED TO COMPUTE Z");
 135           END IF;
 136      END EXAMPLE_3;
 137
 138 EXAMPLE_4:
 139      DECLARE
 140           GENERIC
 141                TYPE T4 IS LIMITED PRIVATE;
 142           PACKAGE GP4 IS
 143                TYPE NT4 IS NEW T4;
 144                X : NT4;
 145           END GP4;
 146
 147           PACKAGE P4 IS NEW GP4 (BOOLEAN);
 148           USE P4;
 149
 150      BEGIN
 151           P4.X := P4.NT4'LAST;
 152           IF ( P4.X  OR (NOT P4.X) ) THEN
 153                REPORT.COMMENT ("P4.X CORRECTLY HAS A BOOLEAN TYPE");
 154           END IF;
 155      END EXAMPLE_4;
 156
 157 EXAMPLE_5:
 158      DECLARE
 159           GENERIC
 160                TYPE T5 (D : POSITIVE) IS PRIVATE;
 161           PACKAGE GP5 IS
 162                TYPE NT5 IS NEW T5;
 163                X : NT5 (D => 5);
 164                Y : POSITIVE := X.D;  -- REFERS TO DISCRIMINANT OF NT5
 165           END GP5;
 166
 167           TYPE REC (A : POSITIVE) IS
 168                RECORD
 169                     D : POSITIVE := 7;
 170                END RECORD;
 171           PACKAGE P5 IS NEW GP5 (T5 => REC);
 172                -- P5.Y INITIALIZED WITH VALUE USING COMPONENT SELECTION
 173                -- OPERATION FOR THE DISCRIMINANT, I.E. FOR PARENT TYPE
 174                -- T5 WHICH DENOTES REC.
 175
 176           W1 : POSITIVE := P5.X.D;     -- VALUE IS 7
 177           W2 : POSITIVE := P5.X.A;     -- VALUE IS 5
 178           W3 : POSITIVE := P5.Y;       -- VALUE IS 5;
 179      BEGIN
 180           IF ( ( W1 /= 7 ) OR ( W2 /= 5 ) OR  (W3 /= 5 ) ) THEN
 181                REPORT.FAILED ("INCORRECT COMPONENT SELECTION");
 182           END IF;
 183      END EXAMPLE_5;
 184
 185      REPORT.RESULT;
 186
 187 END CC3016F;