gcc/testsuite/ada/acats/tests/cd/cd3015i.ada

   1 -- CD3015I.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 ENUMERATION TYPE WITH A REPRESENTATION
  27 --     CLAUSE IN A GENERIC UNIT CAN BE USED CORRECTLY IN ORDERING
  28 --     RELATIONS, INDEXING ARRAYS, AND IN GENERIC INSTANTIATIONS WHEN
  29 --     THERE IS AN ENUMERATION CLAUSE FOR THE PARENT.
  30
  31 -- HISTORY
  32 --     DHH 09/30/87  CREATED ORIGINAL TEST.
  33 --     BCB 03/20/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
  34 --     BCB 03/08/90  REVISED WORDING IN HEADER COMMENT AND IN CALL TO
  35 --                   REPORT.TEST.  ADDED CHECK FOR NON-CONTIGUOUS CODES.
  36 --                   REVISED CHECK FOR ARRAY INDEXING.
  37 --     THS 09/18/90  REVISED WORDING IN HEADER COMMENT AND FIXED FAILURE
  38 --                   ERROR MESSAGE.
  39
  40 WITH REPORT; USE REPORT;
  41 PROCEDURE CD3015I IS
  42
  43 BEGIN
  44
  45      TEST ("CD3015I", "CHECK THAT A DERIVED ENUMERATION TYPE WITH A " &
  46                       "REPRESENTATION CLAUSE IN A GENERIC UNIT CAN " &
  47                       "BE USED CORRECTLY IN ORDERING RELATIONS, " &
  48                       "INDEXING ARRAYS, AND IN GENERIC " &
  49                       "INSTANTIATIONS WHEN THERE IS AN ENUMERATION " &
  50                       "CLAUSE FOR THE PARENT");
  51
  52      DECLARE
  53
  54           GENERIC
  55           PACKAGE GENPACK IS
  56
  57                TYPE MAIN IS (RED,BLUE,YELLOW,'R','B','Y');
  58                FOR MAIN USE
  59                          (RED => 1, BLUE => 2,
  60                                YELLOW => 3, 'R' => 4,
  61                                'B' => 5, 'Y' => 6);
  62
  63                TYPE HUE IS NEW MAIN;
  64                FOR HUE USE
  65                          (RED => 8, BLUE => 9,
  66                                YELLOW => 10, 'R' => 11,
  67                                'B' => 12, 'Y' => 13);
  68
  69                TYPE BASE IS ARRAY(HUE) OF INTEGER;
  70                COLOR,BASIC : HUE;
  71                BARRAY : BASE;
  72
  73                TYPE HUE1 IS NEW MAIN;
  74                FOR HUE1 USE (RED => 10, BLUE => 14, YELLOW => 16,
  75                             'R' => 19, 'B' => 41, 'Y' => 46);
  76
  77                TYPE BASE1 IS ARRAY(HUE1) OF INTEGER;
  78                COLOR1,BASIC1 : HUE1;
  79                BARRAY1 : BASE1;
  80
  81                GENERIC
  82                     TYPE ENUM IS (<>);
  83                PROCEDURE CHANGE(X,Y : IN OUT ENUM);
  84
  85           END GENPACK;
  86
  87           PACKAGE BODY GENPACK IS
  88
  89                PROCEDURE CHANGE(X,Y : IN OUT ENUM) IS
  90                     T : ENUM;
  91                BEGIN
  92                     T := X;
  93                     X := Y;
  94                     Y := T;
  95                END CHANGE;
  96
  97                PROCEDURE PROC IS NEW CHANGE(HUE);
  98                PROCEDURE PROC1 IS NEW CHANGE(HUE1);
  99
 100           BEGIN
 101                BASIC := RED;
 102                COLOR := HUE'SUCC(BASIC);
 103                BASIC1 := RED;
 104                COLOR1 := HUE1'SUCC(BASIC1);
 105                IF (COLOR < BASIC OR BASIC >= 'R' OR 'Y' <= COLOR OR
 106                   COLOR > 'B') OR
 107                   NOT (COLOR1 >= BASIC1 AND BASIC1 < 'R' AND
 108                   'Y' > COLOR1 AND COLOR1 <= 'B') THEN
 109                     FAILED("ORDERING RELATIONS ARE INCORRECT");
 110                END IF;
 111
 112                PROC(BASIC,COLOR);
 113                PROC1(BASIC1,COLOR1);
 114
 115                IF COLOR /= RED OR COLOR1 /= RED THEN
 116                     FAILED("VALUES OF PARAMETERS TO INSTANCE OF " &
 117                            "GENERIC UNIT NOT CORRECT AFTER CALL");
 118                END IF;
 119
 120                BARRAY := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
 121                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
 122
 123                BARRAY1 := (IDENT_INT(1),IDENT_INT(2),IDENT_INT(3),
 124                          IDENT_INT(4),IDENT_INT(5),IDENT_INT(6));
 125
 126                IF (BARRAY (RED) /= 1 OR BARRAY (BLUE) /= 2 OR
 127                    BARRAY (YELLOW) /= 3 OR BARRAY ('R') /= 4 OR
 128                    BARRAY ('B') /= 5 OR BARRAY ('Y') /= 6) OR
 129                   NOT (BARRAY1 (RED) = 1 AND BARRAY1 (BLUE) = 2 AND
 130                    BARRAY1 (YELLOW) = 3 AND BARRAY1 ('R') = 4 AND
 131                    BARRAY1 ('B') = 5 AND BARRAY1 ('Y') = 6)
 132                   THEN
 133                     FAILED("INDEXING ARRAY FAILURE");
 134                END IF;
 135
 136           END GENPACK;
 137
 138           PACKAGE P IS NEW GENPACK;
 139      BEGIN
 140           NULL;
 141      END;
 142
 143      RESULT;
 144 END CD3015I;