gcc/testsuite/ada/acats/tests/c4/c45274a.ada

   1 -- C45274A.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 THE MEMBERSHIP OPERATOR  IN   ( NOT IN )  ALWAYS
  26 --     YIELDS  TRUE   (RESP.  FALSE )  FOR
  27 --
  28 -->> * RECORD TYPES WITHOUT DISCRIMINANTS;
  29 -->> * PRIVATE TYPES WITHOUT DISCRIMINANTS;
  30 -->> * LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS;
  31 --   * (UNCONSTRAINED) RECORD TYPES WITH DISCRIMINANTS;
  32 --   * (UNCONSTRAINED) PRIVATE TYPES WITH DISCRIMINANTS;
  33 --   * (UNCONSTRAINED) LIMITED PRIVATE TYPES WITH DISCRIMINANTS.
  34
  35
  36 -- RM  3/01/82
  37
  38
  39 WITH REPORT;
  40 USE REPORT;
  41 PROCEDURE C45274A IS
  42
  43
  44 BEGIN
  45
  46      TEST ( "C45274A" , "CHECK THAT THE MEMBERSHIP OPERATOR  IN " &
  47                         "  ( NOT IN )  YIELDS  TRUE   (RESP.  FALSE )" &
  48                         " FOR RECORD TYPES WITHOUT DISCRIMINANTS," &
  49                         " PRIVATE TYPES WITHOUT DISCRIMINANTS, AND" &
  50                         " LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS");
  51
  52
  53      -------------------------------------------------------------------
  54      -----------------  RECORD TYPES WITHOUT DISCRIMINANTS  ------------
  55
  56      DECLARE
  57
  58           TYPE  REC  IS
  59                RECORD
  60                     A , B : INTEGER ;
  61                END RECORD ;
  62
  63           X : REC := ( 19 , 91 );
  64
  65      BEGIN
  66
  67           IF  X  IN  REC  THEN
  68                NULL;
  69           ELSE
  70                FAILED( "WRONG VALUE: 'IN', 1" );
  71           END IF;
  72
  73           IF  X  NOT IN  REC  THEN
  74                FAILED( "WRONG VALUE: 'NOT IN', 1" );
  75           ELSE
  76                NULL;
  77           END IF;
  78
  79      EXCEPTION
  80
  81           WHEN  OTHERS =>
  82                FAILED( "1 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
  83
  84      END;
  85
  86
  87      -------------------------------------------------------------------
  88      -----------------  PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
  89
  90      DECLARE
  91
  92           PACKAGE  P  IS
  93                TYPE  PRIV  IS PRIVATE;
  94           PRIVATE
  95                TYPE  PRIV  IS
  96                     RECORD
  97                          A , B : INTEGER ;
  98                     END RECORD ;
  99           END  P ;
 100
 101           USE  P ;
 102
 103           X : PRIV ;
 104
 105           PACKAGE BODY  P  IS
 106           BEGIN
 107                X := ( 19 , 91 );
 108           END  P ;
 109
 110      BEGIN
 111
 112           IF  X  IN  PRIV  THEN
 113                NULL;
 114           ELSE
 115                FAILED( "WRONG VALUE: 'IN', 2" );
 116           END IF;
 117
 118           IF  X  NOT IN  PRIV  THEN
 119                FAILED( "WRONG VALUE: 'NOT IN', 2" );
 120           ELSE
 121                NULL;
 122           END IF;
 123
 124      EXCEPTION
 125
 126           WHEN  OTHERS =>
 127                FAILED( "2 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
 128
 129      END;
 130
 131      -------------------------------------------------------------------
 132      ---------  LIMITED PRIVATE TYPES WITHOUT DISCRIMINANTS  -----------
 133
 134      DECLARE
 135
 136           PACKAGE  P  IS
 137                TYPE  LP  IS LIMITED PRIVATE;
 138           PRIVATE
 139                TYPE  LP  IS
 140                     RECORD
 141                          A , B : INTEGER ;
 142                     END RECORD ;
 143           END  P ;
 144
 145           USE  P ;
 146
 147           X : LP ;
 148
 149           PACKAGE BODY  P  IS
 150           BEGIN
 151                X := ( 19 , 91 );
 152           END  P ;
 153
 154      BEGIN
 155
 156           IF  X  IN  LP  THEN
 157                NULL;
 158           ELSE
 159                FAILED( "WRONG VALUE: 'IN', 3" );
 160           END IF;
 161
 162           IF  X  NOT IN  LP  THEN
 163                FAILED( "WRONG VALUE: 'NOT IN', 3" );
 164           ELSE
 165                NULL;
 166           END IF;
 167
 168      EXCEPTION
 169
 170           WHEN  OTHERS =>
 171                FAILED( "3 -  'IN'  ( 'NOT IN' )  RAISED AN EXCEPTION");
 172
 173      END;
 174
 175      -------------------------------------------------------------------
 176
 177      DECLARE
 178
 179           PACKAGE  P  IS
 180                TYPE  LP  IS LIMITED PRIVATE;
 181           PRIVATE
 182                TYPE  LP  IS
 183                     RECORD
 184                          A , B : INTEGER ;
 185                     END RECORD ;
 186           END  P ;
 187
 188           USE  P ;
 189
 190           Y : LP ;
 191
 192      -- CHECK THAT NO EXCEPTION FOR UNINITIALIZED VARIABLE
 193      BEGIN
 194
 195           IF  Y  IN  LP  THEN
 196                NULL;
 197           ELSE
 198                FAILED( "WRONG VALUE: 'IN', 3BIS" );
 199           END IF;
 200
 201           IF  Y  NOT IN  LP  THEN
 202                FAILED( "WRONG VALUE: 'NOT IN', 3BIS" );
 203           ELSE
 204                NULL;
 205           END IF;
 206
 207      EXCEPTION
 208
 209           WHEN  OTHERS =>
 210                FAILED( "3BIS - UNINITIALIZED VARIABLE - 'IN' " &
 211                        "( 'NOT IN' )  RAISED AN EXCEPTION" );
 212
 213      END;
 214
 215
 216      -------------------------------------------------------------------
 217
 218
 219      RESULT;
 220
 221
 222 END  C45274A ;