gcc/testsuite/ada/acats/tests/c3/c36205k.ada

   1 -- C36205K.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 ATTRIBUTES GIVE THE CORRECT VALUES FOR
  26 -- UNCONSTRAINED FORMAL PARAMETERS.
  27
  28 -- ATTRIBUTES OF SLICE OF SLICE
  29
  30 -- DAT 2/17/81
  31 -- JBG 9/11/81
  32 -- JWC 6/28/85   RENAMED TO -AB
  33
  34 WITH REPORT;
  35 PROCEDURE C36205K IS
  36
  37      USE REPORT;
  38
  39      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
  40      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
  41           INTEGER RANGE <> ) OF INTEGER;
  42      A10 : I_A (1 .. 10);
  43      A20 : I_A (18 .. 20);
  44      I10 : INTEGER := IDENT_INT (10);
  45      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
  46      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
  47      TYPE STR IS NEW STRING;
  48      ALF : CONSTANT STR := STR(IDENT_STR("ABCDE"));
  49      ARF : STR(5 .. 9) := ALF;
  50
  51      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
  52      BEGIN
  53           IF A'FIRST /= FIR
  54              OR A'FIRST(1) /= FIR
  55           THEN
  56                FAILED ("'FIRST IS WRONG " & S);
  57           END IF;
  58
  59           IF A'LAST /= LAS
  60              OR A'LAST(1) /= LAS
  61           THEN
  62                FAILED ("'LAST IS WRONG " & S);
  63           END IF;
  64
  65           IF A'LENGTH /= LAS - FIR + 1
  66              OR A'LENGTH /= A'LENGTH(1)
  67           THEN
  68                FAILED ("'LENGTH IS WRONG " & S);
  69           END IF;
  70
  71           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
  72              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
  73              OR FIR - 1 IN A'RANGE
  74              OR LAS + 1 IN A'RANGE(1)
  75           THEN
  76                FAILED ("'RANGE IS WRONG " & S);
  77           END IF;
  78
  79      END P1;
  80
  81      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
  82      BEGIN
  83           IF A'FIRST /= A'FIRST(1)
  84              OR A'FIRST /= F1
  85           THEN
  86                FAILED ("'FIRST(1) IS WRONG " & S);
  87           END IF;
  88
  89           IF A'LAST(1) /= L1 THEN
  90                FAILED ("'LAST(1) IS WRONG " & S);
  91           END IF;
  92
  93           IF A'LENGTH(1) /= A'LENGTH
  94              OR A'LENGTH /= L1 - F1 + 1
  95           THEN
  96                FAILED ("'LENGTH(1) IS WRONG " & S);
  97           END IF;
  98
  99           IF F1 - 1 IN A'RANGE
 100              OR (F1 NOT IN A'RANGE AND F1 <= L1)
 101              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
 102              OR L1 + 1 IN A'RANGE(1)
 103           THEN
 104                FAILED ("'RANGE(1) IS WRONG " & S);
 105           END IF;
 106
 107           IF A'FIRST(2) /= F2 THEN
 108                FAILED ("'FIRST(2) IS WRONG " & S);
 109           END IF;
 110
 111           IF A'LAST(2) /= L2 THEN
 112                FAILED ("'LAST(2) IS WRONG " & S);
 113           END IF;
 114
 115           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
 116                FAILED ("'LENGTH(2) IS WRONG " & S);
 117           END IF;
 118
 119           IF F2 - 1 IN A'RANGE(2)
 120              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
 121              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
 122              OR L2 + 1 IN A'RANGE(2)
 123           THEN
 124                FAILED ("'RANGE(2) IS WRONG " & S);
 125           END IF;
 126      END P2;
 127
 128      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
 129      BEGIN
 130           IF S'FIRST /= F THEN
 131                FAILED ("STRING 'FIRST IS WRONG " & MESS);
 132           END IF;
 133
 134           IF S'LAST(1) /= L THEN
 135                FAILED ("STRING 'LAST IS WRONG " & MESS);
 136           END IF;
 137
 138           IF S'LENGTH /= L - F + 1
 139              OR S'LENGTH(1) /= S'LENGTH
 140           THEN
 141                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
 142           END IF;
 143
 144           IF (F <= L AND
 145                 (F NOT IN S'RANGE
 146                 OR L NOT IN S'RANGE
 147                 OR F NOT IN S'RANGE(1)
 148                 OR L NOT IN S'RANGE(1)))
 149              OR F - 1 IN S'RANGE
 150              OR L + 1 IN S'RANGE(1)
 151           THEN
 152                FAILED ("STRING 'RANGE IS WRONG " & MESS);
 153           END IF;
 154      END S1;
 155
 156 BEGIN
 157      TEST ( "C36205K", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
 158                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
 159                        "ARRAYS - SLICES OF SLICES");
 160
 161      FOR I IN 18 .. 20 LOOP
 162           FOR J IN I-1 .. 20 LOOP
 163                P1 (A20 (A20'RANGE)(I..J), I, J, "A20 99");
 164           END LOOP;
 165      END LOOP;
 166      FOR I IN 1 .. 5 LOOP
 167           FOR J IN I - 1 .. 5 LOOP
 168                S1 (ALF (1..5)(I..J),I,J,"ALF 3");
 169           END LOOP;
 170      END LOOP;
 171
 172      RESULT;
 173 END C36205K;