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

   1 -- C36205A.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 -- BASIC CHECKS OF ARRAY OBJECTS AND WHOLE ARRAYS PASSED AS
  29 --   PARAMETERS
  30
  31 -- DAT 2/17/81
  32 -- JBG 9/11/81
  33 -- JWC 6/28/85   RENAMED TO -AB
  34
  35 WITH REPORT;
  36 PROCEDURE C36205A IS
  37
  38      USE REPORT;
  39
  40      TYPE I_A IS ARRAY (INTEGER RANGE <> ) OF INTEGER;
  41      TYPE I_A_2 IS ARRAY (INTEGER RANGE <> ,
  42           INTEGER RANGE <> ) OF INTEGER;
  43      A10 : I_A (1 .. 10);
  44      A20 : I_A (18 .. 20);
  45      I10 : INTEGER := IDENT_INT (10);
  46      A2_10 : I_A_2 (1 .. I10, 3+I10 .. I10+I10);       -- 1..10, 13..20
  47      A2_20 : I_A_2 (11 .. 3*I10, I10+11 .. I10+I10);   -- 11..30, 21..20
  48      SUBTYPE STR IS STRING;
  49      ALF : CONSTANT STR(IDENT_INT(1)..IDENT_INT(5)) := "ABCDE";
  50      ARF : STR(5 .. 9) := ALF;
  51
  52      PROCEDURE P1 (A : I_A; FIR, LAS: INTEGER; S : STRING) IS
  53      BEGIN
  54           IF A'FIRST /= FIR
  55              OR A'FIRST(1) /= FIR
  56           THEN
  57                FAILED ("'FIRST IS WRONG " & S);
  58           END IF;
  59
  60           IF A'LAST /= LAS
  61              OR A'LAST(1) /= LAS
  62           THEN
  63                FAILED ("'LAST IS WRONG " & S);
  64           END IF;
  65
  66           IF A'LENGTH /= LAS - FIR + 1
  67              OR A'LENGTH /= A'LENGTH(1)
  68           THEN
  69                FAILED ("'LENGTH IS WRONG " & S);
  70           END IF;
  71
  72           IF (LAS NOT IN A'RANGE AND LAS >= FIR)
  73              OR (FIR NOT IN A'RANGE AND LAS >= FIR)
  74              OR FIR - 1 IN A'RANGE
  75              OR LAS + 1 IN A'RANGE(1)
  76           THEN
  77                FAILED ("'RANGE IS WRONG " & S);
  78           END IF;
  79
  80      END P1;
  81
  82      PROCEDURE P2 (A : I_A_2; F1,L1,F2,L2 : INTEGER; S : STRING) IS
  83      BEGIN
  84           IF A'FIRST /= A'FIRST(1)
  85              OR A'FIRST /= F1
  86           THEN
  87                FAILED ("'FIRST(1) IS WRONG " & S);
  88           END IF;
  89
  90           IF A'LAST(1) /= L1 THEN
  91                FAILED ("'LAST(1) IS WRONG " & S);
  92           END IF;
  93
  94           IF A'LENGTH(1) /= A'LENGTH
  95              OR A'LENGTH /= L1 - F1 + 1
  96           THEN
  97                FAILED ("'LENGTH(1) IS WRONG " & S);
  98           END IF;
  99
 100           IF F1 - 1 IN A'RANGE
 101              OR (F1 NOT IN A'RANGE AND F1 <= L1)
 102              OR (L1 NOT IN A'RANGE(1) AND F1 <= L1)
 103              OR L1 + 1 IN A'RANGE(1)
 104           THEN
 105                FAILED ("'RANGE(1) IS WRONG " & S);
 106           END IF;
 107
 108           IF A'FIRST(2) /= F2 THEN
 109                FAILED ("'FIRST(2) IS WRONG " & S);
 110           END IF;
 111
 112           IF A'LAST(2) /= L2 THEN
 113                FAILED ("'LAST(2) IS WRONG " & S);
 114           END IF;
 115
 116           IF L2 - F2 /= A'LENGTH(2) - 1 THEN
 117                FAILED ("'LENGTH(2) IS WRONG " & S);
 118           END IF;
 119
 120           IF F2 - 1 IN A'RANGE(2)
 121              OR (F2 NOT IN A'RANGE(2) AND A'LENGTH(2) > 0)
 122              OR (L2 NOT IN A'RANGE(2) AND A'LENGTH(2) /= 0)
 123              OR L2 + 1 IN A'RANGE(2)
 124           THEN
 125                FAILED ("'RANGE(2) IS WRONG " & S);
 126           END IF;
 127      END P2;
 128
 129      PROCEDURE S1 (S:STR; F,L:INTEGER; MESS:STRING) IS
 130      BEGIN
 131           IF S'FIRST /= F THEN
 132                FAILED ("STRING 'FIRST IS WRONG " & MESS);
 133           END IF;
 134
 135           IF S'LAST(1) /= L THEN
 136                FAILED ("STRING 'LAST IS WRONG " & MESS);
 137           END IF;
 138
 139           IF S'LENGTH /= L - F + 1
 140              OR S'LENGTH(1) /= S'LENGTH
 141           THEN
 142                FAILED ("STRING 'LENGTH IS WRONG " & MESS);
 143           END IF;
 144
 145           IF (F <= L AND
 146                 (F NOT IN S'RANGE
 147                 OR L NOT IN S'RANGE
 148                 OR F NOT IN S'RANGE(1)
 149                 OR L NOT IN S'RANGE(1)))
 150              OR F - 1 IN S'RANGE
 151              OR L + 1 IN S'RANGE(1)
 152           THEN
 153                FAILED ("STRING 'RANGE IS WRONG " & MESS);
 154           END IF;
 155      END S1;
 156
 157 BEGIN
 158      TEST ( "C36205A", "CHECKING ATTRIBUTE VALUES POSSESSED BY FORMAL "&
 159                        "PARAMETERS WHOSE ACTUALS ARE UNCONSTRAINED " &
 160                        "ARRAYS - BASIC CHECKS");
 161
 162      IF A10'FIRST /= 1
 163         OR A2_10'FIRST(1) /= 1
 164         OR A2_10'FIRST(2) /= IDENT_INT(13)
 165         OR A2_20'FIRST /= 11
 166         OR A2_20'FIRST(2) /= 21
 167      THEN
 168           FAILED ("'FIRST FOR OBJECTS IS WRONG");
 169      END IF;
 170
 171
 172      IF A10'LAST(1) /= 10
 173         OR A2_10'LAST /= 10
 174         OR A2_10'LAST(2) /= 20
 175         OR A2_20'LAST(1) /= 30
 176         OR A2_20'LAST(2) /= IDENT_INT(20)
 177      THEN
 178           FAILED ("'LAST FOR OBJECTS IS WRONG");
 179      END IF;
 180        IF A10'LENGTH /= IDENT_INT(10)
 181         OR A2_10'LENGTH(1) /= 10
 182         OR A2_10'LENGTH(2) /= IDENT_INT(8)
 183         OR A2_20'LENGTH /= 20
 184         OR A2_20'LENGTH(2) /= IDENT_INT(0)
 185      THEN
 186           FAILED ("'LENGTH FOR OBJECTS IS WRONG");
 187      END IF;
 188
 189      IF 0 IN A10'RANGE
 190         OR IDENT_INT(11) IN A10'RANGE(1)
 191         OR IDENT_INT(0) IN A2_10'RANGE(1)
 192         OR 11 IN A2_10'RANGE
 193         OR 12 IN A2_10'RANGE(2)
 194         OR IDENT_INT(21) IN A2_10'RANGE(2)
 195         OR 10 IN A2_20'RANGE
 196         OR IDENT_INT(31) IN A2_20'RANGE(1)
 197         OR IDENT_INT(20) IN A2_20'RANGE(2)
 198         OR 0 IN A2_20'RANGE(2)
 199      THEN
 200           FAILED ("'RANGE FOR OBJECTS IS WRONG");
 201      END IF;
 202
 203      P1 (A10, 1, 10, "P1 1");
 204      P1 (A20, 18, 20, "P1 A20");
 205      P2(A2_10, 1, 10, 13, 20, "P2 1");
 206      P2 (A2_20, 11, 30, 21, 20, "P2 2");
 207      S1 (ALF, 1, 5, "X0");
 208      S1 (ARF, 5, 9, "ARF1");
 209
 210      RESULT;
 211
 212 END C36205A;