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

   1 -- CC3220A.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 -- CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS ACTUAL PARAMETER, AND
  26 -- OPERATIONS OF THE FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING
  27 -- OPERATIONS OF THE ACTUAL TYPE.
  28
  29 -- TBN  10/08/86
  30
  31 WITH REPORT; USE REPORT;
  32 PROCEDURE CC3220A IS
  33
  34      GENERIC
  35           TYPE T IS (<>);
  36      PACKAGE P IS
  37           SUBTYPE SUB_T IS T;
  38           PAC_VAR : T;
  39      END P;
  40
  41 BEGIN
  42      TEST ("CC3220A", "CHECK THAT A DISCRETE FORMAL TYPE DENOTES ITS " &
  43                       "ACTUAL PARAMETER, AND OPERATIONS OF THE " &
  44                       "FORMAL TYPE ARE IDENTIFIED WITH CORRESPONDING " &
  45                       "OPERATIONS OF THE ACTUAL TYPE");
  46
  47      DECLARE
  48           OBJ_INT : INTEGER := 1;
  49
  50           PACKAGE P1 IS NEW P (INTEGER);
  51           USE P1;
  52
  53           TYPE NEW_T IS NEW SUB_T;
  54           OBJ_NEWT : NEW_T;
  55      BEGIN
  56           PAC_VAR := SUB_T'(1);
  57           IF PAC_VAR /= OBJ_INT THEN
  58                FAILED ("INCORRECT RESULTS - 1");
  59           END IF;
  60           OBJ_INT := PAC_VAR + OBJ_INT;
  61           IF OBJ_INT <= PAC_VAR THEN
  62                FAILED ("INCORRECT RESULTS - 2");
  63           END IF;
  64           PAC_VAR := PAC_VAR * OBJ_INT;
  65           IF PAC_VAR NOT IN INTEGER THEN
  66                FAILED ("INCORRECT RESULTS - 3");
  67           END IF;
  68           IF OBJ_INT NOT IN SUB_T THEN
  69                FAILED ("INCORRECT RESULTS - 4");
  70           END IF;
  71           IF INTEGER'POS(2) /= SUB_T'POS(2) THEN
  72                FAILED ("INCORRECT RESULTS - 5");
  73           END IF;
  74           OBJ_NEWT := 1;
  75           OBJ_NEWT := OBJ_NEWT + 1;
  76           IF OBJ_NEWT NOT IN NEW_T THEN
  77                FAILED ("INCORRECT RESULTS - 6");
  78           END IF;
  79           IF NEW_T'SUCC(2) /= 3 THEN
  80                FAILED ("INCORRECT RESULTS - 7");
  81           END IF;
  82      END;
  83
  84      DECLARE
  85           TYPE ENUM IS (RED, YELLOW, GREEN, BLUE);
  86           OBJ_ENU : ENUM := RED;
  87
  88           PACKAGE P2 IS NEW P (ENUM);
  89           USE P2;
  90
  91           TYPE NEW_T IS NEW SUB_T;
  92           OBJ_NEWT : NEW_T;
  93      BEGIN
  94           PAC_VAR := SUB_T'(RED);
  95           IF (PAC_VAR < OBJ_ENU) OR (PAC_VAR > OBJ_ENU) THEN
  96                FAILED ("INCORRECT RESULTS - 8");
  97           END IF;
  98           IF PAC_VAR NOT IN ENUM THEN
  99                FAILED ("INCORRECT RESULTS - 9");
 100           END IF;
 101           IF OBJ_ENU NOT IN SUB_T THEN
 102                FAILED ("INCORRECT RESULTS - 10");
 103           END IF;
 104           IF ENUM'VAL(0) /= SUB_T'VAL(0) THEN
 105                FAILED ("INCORRECT RESULTS - 11");
 106           END IF;
 107           OBJ_ENU := SUB_T'SUCC(PAC_VAR);
 108           IF SUB_T'POS(RED) /= 0 AND THEN OBJ_ENU /= BLUE THEN
 109                FAILED ("INCORRECT RESULTS - 12");
 110           END IF;
 111           OBJ_NEWT := BLUE;
 112           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
 113           IF OBJ_NEWT NOT IN NEW_T THEN
 114                FAILED ("INCORRECT RESULTS - 13");
 115           END IF;
 116           IF NEW_T'WIDTH /= 6 THEN
 117                FAILED ("INCORRECT RESULTS - 14");
 118           END IF;
 119      END;
 120
 121      DECLARE
 122           OBJ_CHR : CHARACTER := 'A';
 123
 124           PACKAGE P3 IS NEW P (CHARACTER);
 125           USE P3;
 126
 127           TYPE NEW_T IS NEW SUB_T;
 128           OBJ_NEWT : NEW_T;
 129           ARA_NEWT : ARRAY (1 .. 5) OF NEW_T;
 130      BEGIN
 131           PAC_VAR := SUB_T'('A');
 132           IF (PAC_VAR < OBJ_CHR) OR (PAC_VAR > OBJ_CHR) THEN
 133                FAILED ("INCORRECT RESULTS - 15");
 134           END IF;
 135           IF PAC_VAR NOT IN CHARACTER THEN
 136                FAILED ("INCORRECT RESULTS - 16");
 137           END IF;
 138           IF OBJ_CHR NOT IN SUB_T THEN
 139                FAILED ("INCORRECT RESULTS - 17");
 140           END IF;
 141           IF CHARACTER'VAL(0) /= SUB_T'VAL(0) THEN
 142                FAILED ("INCORRECT RESULTS - 18");
 143           END IF;
 144           OBJ_CHR := SUB_T'SUCC(PAC_VAR);
 145           IF SUB_T'POS('A') /= 65 AND THEN OBJ_CHR /= 'A' THEN
 146                FAILED ("INCORRECT RESULTS - 19");
 147           END IF;
 148           OBJ_NEWT := 'C';
 149           OBJ_NEWT := NEW_T'PRED(OBJ_NEWT);
 150           IF OBJ_NEWT NOT IN NEW_T THEN
 151                FAILED ("INCORRECT RESULTS - 20");
 152           END IF;
 153           IF NEW_T'IMAGE('A') /= "'A'" THEN
 154                FAILED ("INCORRECT RESULTS - 21");
 155           END IF;
 156           ARA_NEWT := "HELLO";
 157           IF (NEW_T'('H') & NEW_T'('I')) /= "HI" THEN
 158                FAILED ("INCORRECT RESULTS - 22");
 159           END IF;
 160      END;
 161
 162      RESULT;
 163 END CC3220A;