gcc/testsuite/ada/acats/tests/c8/c87b31a.ada

   1 -- C87B31A.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 OVERLOADING RESOLUTION USES THE RULE THAT:
  26 --
  27 -- IF THE TYPE OF AN AGGREGATE IS A ONE-DIMENSIONAL ARRAY TYPE
  28 -- THEN EACH CHOICE MUST SPECIFY VALUES OF THE INDEX TYPE, AND
  29 -- THE EXPRESSION OF EACH COMPONENT ASSOCIATION MUST BE OF THE
  30 -- COMPONENT TYPE.
  31
  32 -- TRH  8 AUG 82
  33 -- DSJ 15 JUN 83
  34 -- JRK  2 FEB 84
  35 -- JBG 4/23/84
  36
  37 WITH REPORT; USE REPORT;
  38
  39 PROCEDURE C87B31A IS
  40
  41      TYPE LETTER  IS NEW CHARACTER RANGE 'A' .. 'Z';
  42      TYPE NOTE    IS (A, B, C, D, E, F, G, H);
  43      TYPE STR     IS NEW STRING (1 .. 1);
  44      TYPE BIT     IS NEW BOOLEAN;
  45      TYPE YES     IS NEW BOOLEAN RANGE TRUE  .. TRUE;
  46      TYPE NO      IS NEW BOOLEAN RANGE FALSE .. FALSE;
  47      TYPE BOOLEAN IS (FALSE, TRUE);
  48      TYPE LIST    IS ARRAY (CHARACTER RANGE <>) OF BIT;
  49      TYPE FLAG    IS (PASS,  FAIL);
  50
  51      SUBTYPE LIST_A  IS LIST('A'..'A');
  52      SUBTYPE LIST_E  IS LIST('E'..'E');
  53      SUBTYPE LIST_AE IS LIST('A'..'E');
  54
  55      GENERIC
  56           TYPE T IS PRIVATE;
  57           ARG  : IN T;
  58           STAT : IN FLAG;
  59      FUNCTION F1 RETURN T;
  60
  61      FUNCTION F1 RETURN T IS
  62      BEGIN
  63           IF STAT = FAIL THEN
  64                FAILED ("RESOLUTION INCORRECT FOR EXPRESSIONS " &
  65                        "IN ARRAY AGGREGATES");
  66           END IF;
  67           RETURN ARG;
  68      END F1;
  69
  70      FUNCTION F IS NEW F1 (BOOLEAN, FALSE, FAIL);
  71      FUNCTION F IS NEW F1 (YES,     TRUE,  FAIL);
  72      FUNCTION F IS NEW F1 (NO,      FALSE, FAIL);
  73      FUNCTION F IS NEW F1 (BIT,     TRUE,  PASS);
  74
  75      FUNCTION G IS NEW F1 (CHARACTER, 'A', PASS);
  76      FUNCTION G IS NEW F1 (LETTER,    'A', FAIL);
  77      FUNCTION G IS NEW F1 (STR,       "A", FAIL);
  78
  79      FUNCTION H IS NEW F1 (CHARACTER, 'E', PASS);
  80      FUNCTION H IS NEW F1 (LETTER,    'E', FAIL);
  81      FUNCTION H IS NEW F1 (STR,       "E", FAIL);
  82
  83 BEGIN
  84      TEST ("C87B31A", "OVERLOADED EXPRESSIONS IN ARRAY AGGREGATES");
  85
  86      DECLARE
  87           L1, L2 : LIST_A :=  (OTHERS => FALSE);
  88           L3, L4 : LIST_E :=  (OTHERS => FALSE);
  89           L5, L6 : LIST_AE := (OTHERS => FALSE);
  90           L7, L8 : LIST_AE := (OTHERS => FALSE);
  91
  92      BEGIN
  93           L1 := ('A' => F);
  94           L2 := ( G  => F);
  95           L3 := ('E' => F);
  96           L4 := ( H  => F);
  97           L5 := ('A'..'E' => F);
  98           L6 := (F,F,F,F,F);
  99           L7 := (F,F,F, OTHERS => F);
 100           L8 := LIST_AE'('E' => F, 'B' => F, OTHERS => F);
 101
 102           IF L1 /= LIST_A'(OTHERS => TRUE) THEN
 103                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 104                          " EXPRESSIONS IN ARRAY AGGREGATES - L1");
 105           END IF;
 106           IF L2 /= LIST_A'(OTHERS => TRUE) THEN
 107                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 108                          " EXPRESSIONS IN ARRAY AGGREGATES - L2");
 109           END IF;
 110           IF L3 /= LIST_E'(OTHERS => TRUE) THEN
 111                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 112                          " EXPRESSIONS IN ARRAY AGGREGATES - L3");
 113           END IF;
 114           IF L4 /= LIST_E'(OTHERS => TRUE) THEN
 115                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 116                          " EXPRESSIONS IN ARRAY AGGREGATES - L4");
 117           END IF;
 118           IF L5 /= LIST_AE'(OTHERS => TRUE) THEN
 119                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 120                          " EXPRESSIONS IN ARRAY AGGREGATES - L5");
 121           END IF;
 122           IF L6 /= LIST_AE'(OTHERS => TRUE) THEN
 123                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 124                          " EXPRESSIONS IN ARRAY AGGREGATES - L6");
 125           END IF;
 126           IF L7 /= LIST_AE'(OTHERS => TRUE) THEN
 127                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 128                          " EXPRESSIONS IN ARRAY AGGREGATES - L7");
 129           END IF;
 130           IF L8 /= LIST_AE'(OTHERS => TRUE) THEN
 131                  FAILED ("RESOLUTION INCORRECT FOR OVERLOADED" &
 132                          " EXPRESSIONS IN ARRAY AGGREGATES - L8");
 133           END IF;
 134      END;
 135
 136      RESULT;
 137 END C87B31A;