gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cd/cd3015e.ada

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