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

   1 -- C45112B.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 BOUNDS OF THE RESULT OF A LOGICAL ARRAY OPERATION
  26 -- ARE THE BOUNDS OF THE LEFT OPERAND WHEN THE OPERANDS ARE NULL
  27 -- ARRAYS.
  28
  29 -- RJW 2/3/86
  30
  31 WITH REPORT; USE REPORT;
  32
  33 PROCEDURE C45112B IS
  34
  35      TYPE ARR IS ARRAY(INTEGER RANGE <>) OF BOOLEAN;
  36      A1 : ARR(IDENT_INT(4) .. IDENT_INT(3));
  37      A2 : ARR(IDENT_INT(2) .. IDENT_INT(1));
  38      SUBTYPE CARR IS ARR (IDENT_INT (A1'FIRST) .. IDENT_INT (A1'LAST));
  39
  40      PROCEDURE CHECK (X : ARR; N1, N2 : STRING) IS
  41      BEGIN
  42           IF X'FIRST /= A1'FIRST OR X'LAST /= A1'LAST THEN
  43                FAILED ( "WRONG BOUNDS FOR " & N1 & " FOR " & N2 );
  44           END IF;
  45      END CHECK;
  46
  47 BEGIN
  48
  49      TEST ( "C45112B", "CHECK THE BOUNDS OF THE RESULT OF LOGICAL " &
  50                        "ARRAY OPERATIONS ON NULL ARRAYS" );
  51
  52      BEGIN
  53           DECLARE
  54                AAND : CONSTANT ARR := A1 AND A2;
  55                AOR  : CONSTANT ARR := A1 OR A2;
  56                AXOR : CONSTANT ARR := A1 XOR A2;
  57           BEGIN
  58                CHECK (AAND, "INITIALIZATION OF CONSTANT ARRAY ",
  59                             "'AND'" );
  60
  61                CHECK (AOR, "INITIALIZATION OF CONSTANT ARRAY ",
  62                             "'OR'" );
  63
  64                CHECK (AXOR, "INITIALIZATION OF CONSTANT ARRAY ",
  65                             "'XOR'" );
  66           END;
  67      EXCEPTION
  68           WHEN CONSTRAINT_ERROR =>
  69                FAILED ( "CONSTRAINT_ERROR RAISED DURING " &
  70                         "INTIALIZATIONS" );
  71           WHEN OTHERS =>
  72                FAILED ( "OTHER EXCEPTION RAISED DURING " &
  73                         "INITIALIZATIONS" );
  74      END;
  75
  76      DECLARE
  77           PROCEDURE PROC (A : ARR; STR : STRING) IS
  78           BEGIN
  79                CHECK (A, "FORMAL PARAMETER FOR CONSTRAINED ARRAY",
  80                       STR);
  81           END PROC;
  82      BEGIN
  83           PROC ((A1 AND A2), "'AND'" );
  84           PROC ((A1 OR A2), "'OR'" );
  85           PROC ((A1 XOR A2), "'XOR'" );
  86      EXCEPTION
  87           WHEN OTHERS =>
  88                FAILED ( "EXCEPTION RAISED DURING TEST FOR FORMAL " &
  89                         "PARAMETERS" );
  90      END;
  91
  92      DECLARE
  93           FUNCTION FUNCAND RETURN ARR IS
  94           BEGIN
  95                RETURN A1 AND A2;
  96           END FUNCAND;
  97
  98           FUNCTION FUNCOR RETURN ARR IS
  99           BEGIN
 100                RETURN A1 OR A2;
 101           END FUNCOR;
 102
 103           FUNCTION FUNCXOR RETURN ARR IS
 104           BEGIN
 105                RETURN A1 XOR A2;
 106           END FUNCXOR;
 107
 108      BEGIN
 109           CHECK (FUNCAND, "RETURN STATEMENT", "'AND'");
 110           CHECK (FUNCOR, "RETURN STATEMENT", "'OR'");
 111           CHECK (FUNCXOR, "RETURN STATEMENT", "'XOR'");
 112
 113      EXCEPTION
 114           WHEN OTHERS =>
 115                FAILED ( "EXCEPTION RAISED DURING TEST FOR RETURN " &
 116                         "FROM FUNCTION" );
 117      END;
 118
 119      BEGIN
 120           DECLARE
 121                GENERIC
 122                    X : IN ARR;
 123                PACKAGE PKG IS
 124                     FUNCTION G RETURN ARR;
 125                END PKG;
 126
 127                PACKAGE BODY PKG IS
 128                     FUNCTION G RETURN ARR IS
 129                     BEGIN
 130                          RETURN X;
 131                     END G;
 132                END PKG;
 133
 134                PACKAGE PAND IS NEW PKG(X => A1 AND A2);
 135                PACKAGE POR IS NEW PKG(X => A1 OR A2);
 136                PACKAGE PXOR IS NEW PKG(X => A1 XOR A2);
 137           BEGIN
 138                CHECK (PAND.G, "GENERIC FORMAL PARAMETER", "'AND'");
 139                CHECK (POR.G, "GENERIC FORMAL PARAMETER", "'OR'");
 140                CHECK (PXOR.G, "GENERIC FORMAL PARAMMETER", "'XOR'");
 141           END;
 142      EXCEPTION
 143           WHEN OTHERS =>
 144                FAILED ( "EXCEPTION RAISED DURING GENERIC " &
 145                         "INSTANTIATION" );
 146      END;
 147
 148      DECLARE
 149           TYPE ACC IS ACCESS ARR;
 150           AC : ACC;
 151
 152      BEGIN
 153           AC :=  NEW ARR'(A1 AND A2);
 154           CHECK (AC.ALL, "ALLOCATION", "'AND'");
 155           AC :=  NEW ARR'(A1 OR A2);
 156           CHECK (AC.ALL, "ALLOCATION", "'OR'");
 157           AC :=  NEW ARR'(A1 XOR A2);
 158           CHECK (AC.ALL, "ALLOCATION", "'XOR'");
 159      EXCEPTION
 160           WHEN OTHERS =>
 161                FAILED ( "EXCEPTION RAISED ON ALLOCATION" );
 162      END;
 163
 164      BEGIN
 165           CHECK (CARR' (A1 AND A2), "QUALIFIED EXPRESSION", "'AND'");
 166           CHECK (CARR' (A1 OR A2), "QUALIFIED EXPRESSION", "'OR'");
 167           CHECK (CARR' (A1 XOR A2), "QUALIFIED EXPRESSION", "'XOR'");
 168      EXCEPTION
 169           WHEN OTHERS =>
 170                FAILED ( "EXCEPTION RAISED ON QUALIFIED EXPRESSION" );
 171      END;
 172
 173      DECLARE
 174           TYPE REC IS
 175                RECORD
 176                     RCA : CARR;
 177                END RECORD;
 178           R1 : REC;
 179
 180      BEGIN
 181           R1 := (RCA => (A1 AND A2));
 182           CHECK (R1.RCA, "AGGREGATE", "'AND'");
 183           R1 := (RCA => (A1 OR A2));
 184           CHECK (R1.RCA, "AGGREGATE", "'OR'");
 185           R1 := (RCA => (A1 XOR A2));
 186           CHECK (R1.RCA, "AGGREGATE", "'XOR'");
 187      EXCEPTION
 188           WHEN OTHERS =>
 189                FAILED ( "EXCEPTION RAISED ON AGGREGATE" );
 190      END;
 191
 192      BEGIN
 193           DECLARE
 194                TYPE RECDEF IS
 195                     RECORD
 196                          RCDF1 : CARR := A1 AND A2;
 197                          RCDF2 : CARR := A1 OR A2;
 198                          RCDF3 : CARR := A1 XOR A2;
 199                     END RECORD;
 200                RD : RECDEF;
 201           BEGIN
 202                CHECK (RD.RCDF1, "DEFAULT RECORD", "'AND'");
 203                CHECK (RD.RCDF2, "DEFAULT RECORD", "'OR'");
 204                CHECK (RD.RCDF3, "DEFAULT RECORD", "'XOR'");
 205           EXCEPTION
 206                WHEN OTHERS =>
 207                     FAILED ( "EXCEPTION RAISED ON DEFAULT RECORD" );
 208           END;
 209      EXCEPTION
 210           WHEN OTHERS =>
 211                FAILED ( "EXCEPTION RAISED DURING INITIALIZATION OF " &
 212                         "DEFAULT RECORD" );
 213      END;
 214
 215      DECLARE
 216           PROCEDURE PDEF (X : CARR := A1 AND A2;
 217                           Y : CARR := A1 OR A2;
 218                           Z : CARR := A1 XOR A2 ) IS
 219           BEGIN
 220                CHECK (X, "DEFAULT PARAMETER", "'AND'");
 221                CHECK (Y, "DEFAULT PARAMETER", "'OR'");
 222                CHECK (Z, "DEFAULT PARAMETER", "'XOR'");
 223           END PDEF;
 224
 225      BEGIN
 226           PDEF;
 227      EXCEPTION
 228           WHEN OTHERS =>
 229                FAILED ( "EXCEPTION RAISED ON DEFAULT PARM" );
 230      END;
 231
 232      RESULT;
 233
 234 END C45112B;