gomp-20050608-branch/gcc/testsuite/ada/acats/tests/c4/c46041a.ada

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