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

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