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

   1 -- C36305A.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 A STRING VARIABLE IS CONSIDERED AN ARRAY.
  26
  27 -- DAT 2/17/81
  28 -- SPS 10/25/82
  29 -- EDS 07/16/98    AVOID OPTIMIZATION
  30
  31 WITH REPORT;
  32 PROCEDURE C36305A IS
  33
  34      USE REPORT;
  35
  36      S : STRING (IDENT_INT(5) .. IDENT_INT (10));
  37      T : STRING (S'RANGE);
  38      U : STRING (T'FIRST .. T'LAST);
  39      SUBTYPE I_5 IS INTEGER RANGE U'RANGE(1);
  40      I5 : I_5;
  41      C : CONSTANT STRING := "ABCDEF";
  42
  43 BEGIN
  44      TEST ("C36305A", "CHECK THAT STRINGS ARE REALLY ARRAYS");
  45
  46      IF S'FIRST /= 5
  47      OR S'LAST /= 10
  48      OR S'LENGTH /= 6
  49      OR U'FIRST(1) /= 5
  50      OR U'LAST(1) /= 10
  51      OR U'LENGTH(1) /= 6
  52      THEN
  53           FAILED ("INCORRECT STRING ATTRIBUTE VALUES");
  54      END IF;
  55
  56      IF 4 IN U'RANGE
  57      OR 3 IN U'RANGE(1)
  58      OR 0 IN U'RANGE
  59      OR 1 IN U'RANGE
  60      OR 5 NOT IN U'RANGE
  61      OR 7 NOT IN U'RANGE
  62      OR 10 NOT IN U'RANGE
  63      OR NOT (11 NOT IN U'RANGE)
  64      THEN
  65           FAILED ("INCORRECT STRING RANGE ATTRIBUTE");
  66      END IF;
  67
  68      BEGIN
  69           BEGIN
  70                BEGIN
  71                     I5 := 4;
  72                     FAILED ("BAD I5 SUBRANGE 1 " & INTEGER'IMAGE(I5)); --use I5
  73                EXCEPTION
  74                     WHEN CONSTRAINT_ERROR => NULL;
  75                END;
  76                I5 := INTEGER'(11);
  77                FAILED ("BAD I5 SUBRANGE 2 " & INTEGER'IMAGE(I5)); --use I5
  78           EXCEPTION
  79                WHEN CONSTRAINT_ERROR => NULL;
  80                WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 1");
  81           END;
  82           I5 := INTEGER'(5);
  83           I5 := I5 + I5;
  84           I5 := NATURAL'(8);
  85      EXCEPTION
  86           WHEN OTHERS => FAILED ("WRONG EXCEPTION RAISED 2");
  87      END;
  88
  89      FOR I IN S'RANGE LOOP
  90           S(I) :=  C(11 - I);
  91      END LOOP;
  92      T := S;
  93      FOR I IN REVERSE U'RANGE LOOP
  94           U(I) := T(15 - I);
  95      END LOOP;
  96
  97      FOR I IN 1 .. C'LENGTH LOOP
  98           IF C(1 .. I) /= U(5 .. I + 4)
  99           OR U(I + 4 .. U'LAST) /= C(I .. C'LAST)
 100           OR C(I) /= U (I + 4)
 101           OR C(I .. I)(I .. I)(I) /= U(U'RANGE)(I + 4) THEN
 102                FAILED ("INCORRECT CHARACTER MISMATCH IN STRING");
 103                EXIT;
 104           END IF;
 105      END LOOP;
 106
 107      IF U /= C
 108      OR U /= "ABCDEF"
 109      OR U(U'RANGE) /= C(C'RANGE)
 110      OR U(5 .. 10) /= C(1 .. 6)
 111      OR U(5 .. 6) /= C(1 .. 2)
 112      THEN
 113           FAILED ("STRINGS AS ARRAYS BEHAVE INCORRECTLY");
 114      END IF;
 115
 116      RESULT;
 117 END C36305A;