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

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