gcc/testsuite/ada/acats/tests/c4/c46042a.ada

   1 -- C46042A.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 ARRAY CONVERSIONS WHEN THE TARGET TYPE IS A CONSTRAINED
  26 -- ARRAY TYPE AND THE OPERAND TYPE HAS BOUNDS THAT DO NOT BELONG TO
  27 -- THE BASE TYPE OF THE TARGET TYPE'S INDEX SUBTYPE.
  28
  29 -- R.WILLIAMS 9/8/86
  30
  31 WITH REPORT; USE REPORT;
  32 PROCEDURE C46042A IS
  33
  34      TYPE INT IS RANGE -100 .. 100;
  35
  36      TYPE NEWINTEGER IS NEW INTEGER;
  37
  38      TYPE DAY IS (SUN, MON, TUE, WED, THU, FRI, SAT);
  39
  40      TYPE NDAY1 IS NEW DAY RANGE MON .. FRI;
  41      TYPE NDAY2 IS NEW DAY RANGE MON .. FRI;
  42
  43      TYPE NNDAY1 IS NEW NDAY1;
  44
  45      FUNCTION IDENT (X : INT) RETURN INT IS
  46      BEGIN
  47           RETURN INT'VAL (IDENT_INT (INT'POS (X)));
  48      END IDENT;
  49
  50      FUNCTION IDENT (X : NEWINTEGER) RETURN NEWINTEGER IS
  51      BEGIN
  52           RETURN NEWINTEGER'VAL (IDENT_INT (NEWINTEGER'POS (X)));
  53      END IDENT;
  54
  55      FUNCTION IDENT (X : NDAY1) RETURN NDAY1 IS
  56      BEGIN
  57           RETURN NDAY1'VAL (IDENT_INT (NDAY1'POS (X)));
  58      END IDENT;
  59
  60      FUNCTION IDENT (X : NDAY2) RETURN NDAY2 IS
  61      BEGIN
  62           RETURN NDAY2'VAL (IDENT_INT (NDAY2'POS (X)));
  63      END IDENT;
  64
  65      FUNCTION IDENT (X : NNDAY1) RETURN NNDAY1 IS
  66      BEGIN
  67           RETURN NNDAY1'VAL (IDENT_INT (NNDAY1'POS (X)));
  68      END IDENT;
  69
  70 BEGIN
  71      TEST ( "C46042A", "CHECK ARRAY CONVERSIONS WHEN THE TARGET " &
  72                        "TYPE IS A CONSTRAINED ARRAY TYPE AND THE " &
  73                        "OPERAND TYPE HAS BOUNDS THAT DO NOT " &
  74                        "BELONG TO THE BASE TYPE OF THE TARGET " &
  75                        "TYPE'S INDEX SUBTYPE" );
  76
  77      DECLARE
  78
  79           TYPE UNARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
  80           SUBTYPE CONARR1 IS UNARR1 (IDENT_INT (1) .. IDENT_INT (10));
  81
  82           TYPE UNARR2 IS ARRAY (INTEGER RANGE <>, NDAY1 RANGE <>)
  83                OF INTEGER;
  84           SUBTYPE CONARR2 IS UNARR2 (IDENT_INT (1) .. IDENT_INT (10),
  85                                      IDENT (MON) .. IDENT (TUE));
  86
  87           TYPE ARR1 IS ARRAY (INT RANGE <>) OF INTEGER;
  88           A1 : ARR1 (IDENT (11) .. IDENT (20)) :=
  89                     (IDENT (11) .. IDENT (20) => 0);
  90
  91           TYPE ARR2 IS ARRAY (INT RANGE <>, NDAY2 RANGE <>)
  92                OF INTEGER;
  93           A2 : ARR2 (IDENT (11) .. IDENT (20),
  94                      IDENT (WED) .. IDENT (THU)) :=
  95                     (IDENT (11) .. IDENT (20) =>
  96                     (IDENT (WED) .. IDENT (THU) => 0));
  97
  98           TYPE ARR3 IS ARRAY (NEWINTEGER RANGE <>, NNDAY1 RANGE <>)
  99                OF INTEGER;
 100           A3 : ARR3 (IDENT (11) .. IDENT (20),
 101                      IDENT (WED) .. IDENT (THU)) :=
 102                     (IDENT (11) .. IDENT (20) =>
 103                     (IDENT (WED) .. IDENT (THU) => 0));
 104
 105           PROCEDURE CHECK (A : UNARR1) IS
 106           BEGIN
 107                IF A'FIRST /= 1 OR A'LAST /= 10 THEN
 108                     FAILED ( "INCORRECT CONVERSION OF UNARR1 (A1)" );
 109                END IF;
 110           END CHECK;
 111
 112           PROCEDURE CHECK (A : UNARR2; STR : STRING) IS
 113           BEGIN
 114                IF A'FIRST (1) /= 1 OR A'LAST /= 10 OR
 115                   A'FIRST (2) /= MON OR A'LAST (2) /= TUE THEN
 116                     FAILED ( "INCORRECT CONVERSION OF UNARR2 (A" &
 117                               STR & ")" );
 118                END IF;
 119           END CHECK;
 120
 121      BEGIN
 122           BEGIN
 123                CHECK (CONARR1 (A1));
 124           EXCEPTION
 125                WHEN OTHERS =>
 126                     FAILED ( "EXCEPTION RAISED BY 'CONARR1 (A1)'" );
 127           END;
 128
 129           BEGIN
 130                CHECK (CONARR2 (A2), "2");
 131           EXCEPTION
 132                WHEN OTHERS =>
 133                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A2)'" );
 134           END;
 135
 136           BEGIN
 137                CHECK (CONARR2 (A3), "3");
 138           EXCEPTION
 139                WHEN OTHERS =>
 140                     FAILED ( "EXCEPTION RAISED BY 'CONARR2 (A3)'" );
 141           END;
 142
 143      END;
 144
 145      RESULT;
 146 END C46042A;