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

   1 -- C45282A.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 IN AND NOT IN ARE EVALUATED CORRECTLY FOR :
  26 --     A) ACCESS TO SCALAR TYPES;
  27 --     B) ACCESS TO ARRAY TYPES (CONSTRAINED AND UNCONSTRAINED);
  28 --     C) ACCESS TO RECORD, PRIVATE, AND LIMITED PRIVATE TYPES WITHOUT
  29 --        DISCRIMINANTS;
  30
  31 -- TBN  8/8/86
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C45282A IS
  35
  36      PACKAGE P IS
  37           TYPE KEY IS PRIVATE;
  38           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY;
  39           TYPE NEWKEY IS LIMITED PRIVATE;
  40           TYPE ACC_NKEY IS ACCESS NEWKEY;
  41           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY);
  42      PRIVATE
  43           TYPE KEY IS NEW NATURAL;
  44           TYPE NEWKEY IS NEW KEY;
  45      END P;
  46
  47      USE P;
  48      SUBTYPE I IS INTEGER;
  49      TYPE ACC_INT IS ACCESS I;
  50      P_INT : ACC_INT;
  51      SUBTYPE INT IS INTEGER RANGE 1 .. 5;
  52      TYPE ARRAY_TYPE1 IS ARRAY (INT RANGE <>) OF INTEGER;
  53      TYPE ACC_ARA_1 IS ACCESS ARRAY_TYPE1;
  54      SUBTYPE ACC_ARA_2 IS ACC_ARA_1 (1 .. 2);
  55      SUBTYPE ACC_ARA_3 IS ACC_ARA_1 (1 .. 3);
  56      ARA1 : ACC_ARA_1;
  57      ARA2 : ACC_ARA_2;
  58      ARA3 : ACC_ARA_3;
  59      TYPE GREET IS
  60           RECORD
  61                NAME : STRING (1 .. 2);
  62           END RECORD;
  63      TYPE ACC_GREET IS ACCESS GREET;
  64      INTRO : ACC_GREET;
  65      TYPE ACC_KEY IS ACCESS KEY;
  66      KEY1 : ACC_KEY;
  67      KEY2 : ACC_NKEY;
  68
  69      PACKAGE BODY P IS
  70           FUNCTION INIT_KEY (X : NATURAL) RETURN KEY IS
  71           BEGIN
  72                RETURN (KEY(X));
  73           END INIT_KEY;
  74
  75           PROCEDURE ASSIGN_NEWKEY (Y : IN OUT ACC_NKEY) IS
  76           BEGIN
  77                Y.ALL := NEWKEY (1);
  78           END ASSIGN_NEWKEY;
  79      END P;
  80
  81 BEGIN
  82
  83      TEST ("C45282A", "CHECK THAT IN AND NOT IN ARE EVALUATED FOR " &
  84                       "ACCESS TYPES TO SCALAR TYPES, ARRAY TYPES, " &
  85                       "RECORD TYPES, PRIVATE TYPES, AND LIMITED " &
  86                       "PRIVATE TYPES WITHOUT DISCRIMINANTS");
  87
  88 -- CASE A
  89      IF P_INT NOT IN ACC_INT THEN
  90           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 1");
  91      END IF;
  92      P_INT := NEW INT'(5);
  93      IF P_INT IN ACC_INT THEN
  94           NULL;
  95      ELSE
  96           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 2");
  97      END IF;
  98
  99 -- CASE B
 100      IF ARA1 NOT IN ACC_ARA_1 THEN
 101           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 3");
 102      END IF;
 103      IF ARA1 NOT IN ACC_ARA_2 THEN
 104           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 4");
 105      END IF;
 106      IF ARA1 IN ACC_ARA_3 THEN
 107           NULL;
 108      ELSE
 109           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 5");
 110      END IF;
 111      IF ARA2 IN ACC_ARA_1 THEN
 112           NULL;
 113      ELSE
 114           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 6");
 115      END IF;
 116      IF ARA3 NOT IN ACC_ARA_1 THEN
 117           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 7");
 118      END IF;
 119      ARA1 := NEW ARRAY_TYPE1'(1, 2, 3);
 120      IF ARA1 IN ACC_ARA_1 THEN
 121           NULL;
 122      ELSE
 123           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 8");
 124      END IF;
 125      IF ARA1 IN ACC_ARA_2 THEN
 126           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 9");
 127      END IF;
 128      IF ARA1 NOT IN ACC_ARA_3 THEN
 129           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 10");
 130      END IF;
 131      ARA2 := NEW ARRAY_TYPE1'(1, 2);
 132      IF ARA2 NOT IN ACC_ARA_1 THEN
 133           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 11");
 134      END IF;
 135      IF ARA2 NOT IN ACC_ARA_2 THEN
 136           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 12");
 137      END IF;
 138
 139 -- CASE C
 140      IF INTRO NOT IN ACC_GREET THEN
 141           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 13");
 142      END IF;
 143      INTRO := NEW GREET'(NAME => "HI");
 144      IF INTRO IN ACC_GREET THEN
 145           NULL;
 146      ELSE
 147           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 14");
 148      END IF;
 149      IF KEY1 NOT IN ACC_KEY THEN
 150           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 15");
 151      END IF;
 152      KEY1 := NEW KEY'(INIT_KEY (1));
 153      IF KEY1 IN ACC_KEY THEN
 154           NULL;
 155      ELSE
 156           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 16");
 157      END IF;
 158      IF KEY2 NOT IN ACC_NKEY THEN
 159           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 17");
 160      END IF;
 161      KEY2 := NEW NEWKEY;
 162      ASSIGN_NEWKEY (KEY2);
 163      IF KEY2 IN ACC_NKEY THEN
 164           NULL;
 165      ELSE
 166           FAILED ("INCORRECT RESULTS FOR ACCESS TYPES - 18");
 167      END IF;
 168
 169      RESULT;
 170 END C45282A;