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

   1 -- C43208B.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 -- FOR AN AGGREGATE OF THE FORM:
  26 --        (B..C => (D..E => (F..G => (H..I => J))))
  27 -- WHOSE TYPE IS A TWO-DIMENSIONAL ARRAY TYPE THAT HAS A TWO-
  28 -- DIMENSIONAL ARRAY COMPONENT TYPE, CHECK THAT:
  29
  30 --     A) IF B..C OR D..E IS A NULL RANGE, THEN F, G, H, I, AND J
  31 --        ARE NOT EVALUATED.
  32
  33 --     B) IF B..C AND D..E ARE NON-NULL RANGES, THEN F, G, H AND I
  34 --        ARE EVALUATED (C-B+1)*(E-D+1) TIMES, AND J IS EVALUATED
  35 --        (C-B+1)*(E-D+1)*(G-F+1)*(I-H+1) TIMES IF F..G AND H..I
  36 --        ARE NON-NULL.
  37
  38 -- EG  01/19/84
  39
  40 WITH REPORT;
  41
  42 PROCEDURE C43208B IS
  43
  44      USE REPORT;
  45
  46 BEGIN
  47
  48      TEST("C43208B", "CHECK THAT THE EVALUATION OF A MULTI" &
  49                      "DIMENSIONAL ARRAY TYPE THAT HAS AN "  &
  50                      "ARRAY COMPONENT TYPE IS PERFORMED "   &
  51                      "CORRECTLY");
  52
  53      DECLARE
  54
  55           TYPE CHOICE_INDEX IS (B, C, D, E, F, G, H, I, J);
  56           TYPE CHOICE_CNTR  IS ARRAY(CHOICE_INDEX) OF INTEGER;
  57
  58           CNTR : CHOICE_CNTR := (CHOICE_INDEX => 0);
  59
  60           TYPE T1 IS ARRAY(INTEGER RANGE <>, INTEGER RANGE <>)
  61                           OF INTEGER;
  62
  63           FUNCTION CALC (A : CHOICE_INDEX; B : INTEGER)
  64                          RETURN INTEGER IS
  65           BEGIN
  66                CNTR(A) := CNTR(A) + 1;
  67                RETURN IDENT_INT(B);
  68           END CALC;
  69
  70      BEGIN
  71
  72 CASE_A :  BEGIN
  73
  74      CASE_A1 : DECLARE
  75                     A1 : ARRAY(4 .. 3, 3 .. 4) OF T1(2 .. 3, 1 .. 2);
  76                BEGIN
  77                     CNTR := (CHOICE_INDEX => 0);
  78                     A1 := (4 .. 3 => (3 .. 4 =>
  79                             (CALC(F,2) .. CALC(G,3) =>
  80                               (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
  81                     IF CNTR(F) /= 0 THEN
  82                          FAILED("CASE A1 : F WAS EVALUATED");
  83                     END IF;
  84                     IF CNTR(G) /= 0 THEN
  85                          FAILED("CASE A1 : G WAS EVALUATED");
  86                     END IF;
  87                     IF CNTR(H) /= 0 THEN
  88                          FAILED("CASE A1 : H WAS EVALUATED");
  89                     END IF;
  90                     IF CNTR(I) /= 0 THEN
  91                          FAILED("CASE A1 : I WAS EVALUATED");
  92                     END IF;
  93                     IF CNTR(J) /= 0 THEN
  94                          FAILED("CASE A1 : J WAS EVALUATED");
  95                     END IF;
  96                EXCEPTION
  97                     WHEN OTHERS =>
  98                          FAILED("CASE A1 : EXCEPTION RAISED");
  99                END CASE_A1;
 100
 101      CASE_A2 : DECLARE
 102                     A2 : ARRAY(3 .. 4, 4 .. 3) OF T1(2 .. 3, 1 .. 2);
 103                BEGIN
 104                     CNTR := (CHOICE_INDEX => 0);
 105                     A2 := (CALC(B,3) .. CALC(C,4) =>
 106                            (CALC(D,4) .. CALC(E,3) =>
 107                             (CALC(F,2) .. CALC(G,3) =>
 108                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
 109                     IF CNTR(F) /= 0 THEN
 110                          FAILED("CASE A2 : F WAS EVALUATED");
 111                     END IF;
 112                     IF CNTR(G) /= 0 THEN
 113                          FAILED("CASE A2 : G WAS EVALUATED");
 114                     END IF;
 115                     IF CNTR(H) /= 0 THEN
 116                          FAILED("CASE A2 : H WAS EVALUATED");
 117                     END IF;
 118                     IF CNTR(I) /= 0 THEN
 119                          FAILED("CASE A2 : I WAS EVALUATED");
 120                     END IF;
 121                     IF CNTR(J) /= 0 THEN
 122                          FAILED("CASE A2 : J WAS EVALUATED");
 123                     END IF;
 124                EXCEPTION
 125                     WHEN OTHERS =>
 126                          FAILED("CASE A2 : EXCEPTION RAISED");
 127                END CASE_A2;
 128
 129           END CASE_A;
 130
 131 CASE_B :  BEGIN
 132
 133      CASE_B1 : DECLARE
 134                     B1 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
 135                BEGIN
 136                     CNTR := (CHOICE_INDEX => 0);
 137                     B1 := (2 .. 3 => (1 .. 2 =>
 138                             (CALC(F,1) .. CALC(G,2) =>
 139                               (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
 140                     IF CNTR(F) /= 4 THEN
 141                          FAILED("CASE B1 : F NOT EVALUATED (C-B+1)*" &
 142                                 "(E-D+1) TIMES");
 143                     END IF;
 144                     IF CNTR(G) /= 4 THEN
 145                          FAILED("CASE B1 : G NOT EVALUATED (C-B+1)*" &
 146                                 "(E-D+1) TIMES");
 147                     END IF;
 148                     IF CNTR(H) /= 4 THEN
 149                          FAILED("CASE B1 : H NOT EVALUATED (C-B+1)*" &
 150                                 "(E-D+1) TIMES");
 151                     END IF;
 152                     IF CNTR(I) /= 4 THEN
 153                          FAILED("CASE B1 : I NOT EVALUATED (C-B+1)*" &
 154                                 "(E-D+1) TIMES");
 155                     END IF;
 156                     IF CNTR(J) /= 16 THEN
 157                          FAILED("CASE B1 : J NOT EVALUATED (C-B+1)*" &
 158                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
 159                     END IF;
 160                EXCEPTION
 161                     WHEN OTHERS =>
 162                          FAILED("CASE B1 : EXECEPTION RAISED");
 163                END CASE_B1;
 164
 165      CASE_B2 : DECLARE
 166                     B2 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 9 .. 10);
 167                BEGIN
 168                     CNTR := (CHOICE_INDEX => 0);
 169                     B2 := (CALC(B,2) .. CALC(C,3) =>
 170                            (CALC(D,1) .. CALC(E,2) =>
 171                             (CALC(F,1) .. CALC(G,2) =>
 172                              (CALC(H,9) .. CALC(I,10) => CALC(J,2)))));
 173                     IF CNTR(F) /= 4 THEN
 174                          FAILED("CASE B2 : F NOT EVALUATED (C-B+1)*" &
 175                                 "(E-D+1) TIMES");
 176                     END IF;
 177                     IF CNTR(G) /= 4 THEN
 178                          FAILED("CASE B2 : G NOT EVALUATED (C-B+1)*" &
 179                                 "(E-D+1) TIMES");
 180                     END IF;
 181                     IF CNTR(H) /= 4 THEN
 182                          FAILED("CASE B2 : H NOT EVALUATED (C-B+1)*" &
 183                                 "(E-D+1) TIMES");
 184                     END IF;
 185                     IF CNTR(I) /= 4 THEN
 186                          FAILED("CASE B2 : I NOT EVALUATED (C-B+1)*" &
 187                                 "(E-D+1) TIMES");
 188                     END IF;
 189                     IF CNTR(J) /= 16 THEN
 190                          FAILED("CASE B2 : J NOT EVALUATED (C-B+1)*" &
 191                                 "(E-D+1)*(G-F+1)*(I-H+1) TIMES");
 192                     END IF;
 193                EXCEPTION
 194                     WHEN OTHERS =>
 195                          FAILED("CASE B2 : EXECEPTION RAISED");
 196                END CASE_B2;
 197
 198      CASE_B3 : DECLARE
 199                     B3 : ARRAY(2 .. 3, 1 .. 2) OF T1(1 .. 2, 2 .. 1);
 200                BEGIN
 201                     CNTR := (CHOICE_INDEX => 0);
 202                     B3 := (2 .. 3 => (1 .. 2 =>
 203                             (CALC(F,1) .. CALC(G,2) =>
 204                               (CALC(H,2) .. CALC(I,1) => CALC(J,2)))));
 205                     IF CNTR(F) /= 4 THEN
 206                          FAILED("CASE B3 : F NOT EVALUATED (C-B+1)*" &
 207                                 "(E-D+1) TIMES");
 208                     END IF;
 209                     IF CNTR(G) /= 4 THEN
 210                          FAILED("CASE B3 : G NOT EVALUATED (C-B+1)*" &
 211                                 "(E-D+1) TIMES");
 212                     END IF;
 213                     IF CNTR(H) /= 4 THEN
 214                          FAILED("CASE B3 : H NOT EVALUATED (C-B+1)*" &
 215                                 "(E-D+1) TIMES");
 216                     END IF;
 217                     IF CNTR(I) /= 4 THEN
 218                          FAILED("CASE B3 : I NOT EVALUATED (C-B+1)*" &
 219                                 "(E-D+1) TIMES");
 220                     END IF;
 221                     IF CNTR(J) /= 0 THEN
 222                          FAILED("CASE B3 : J NOT EVALUATED ZERO TIMES");
 223                     END IF;
 224                EXCEPTION
 225                     WHEN OTHERS =>
 226                          FAILED("CASE B3 : EXECEPTION RAISED");
 227                END CASE_B3;
 228
 229      CASE_B4 : DECLARE
 230                     B4 : ARRAY(2 .. 3, 1 .. 2) OF T1(2 .. 1, 1 .. 2);
 231                BEGIN
 232                     CNTR := (CHOICE_INDEX => 0);
 233                     B4 := (CALC(B,2) .. CALC(C,3) =>
 234                            (CALC(D,1) .. CALC(E,2) =>
 235                             (CALC(F,2) .. CALC(G,1) =>
 236                              (CALC(H,1) .. CALC(I,2) => CALC(J,2)))));
 237                     IF CNTR(F) /= 4 THEN
 238                          FAILED("CASE B4 : F NOT EVALUATED (C-B+1)*" &
 239                                 "(E-D+1) TIMES");
 240                     END IF;
 241                     IF CNTR(G) /= 4 THEN
 242                          FAILED("CASE B4 : G NOT EVALUATED (C-B+1)*" &
 243                                 "(E-D+1) TIMES");
 244                     END IF;
 245                     IF CNTR(H) /= 4 THEN
 246                          FAILED("CASE B4 : H NOT EVALUATED (C-B+1)*" &
 247                                 "(E-D+1) TIMES");
 248                     END IF;
 249                     IF CNTR(I) /= 4 THEN
 250                          FAILED("CASE B4 : I NOT EVALUATED (C-B+1)*" &
 251                                 "(E-D+1) TIMES");
 252                     END IF;
 253                     IF CNTR(J) /= 0 THEN
 254                          FAILED("CASE B4 : J NOT EVALUATED ZERO TIMES");
 255                     END IF;
 256                EXCEPTION
 257                     WHEN OTHERS =>
 258                          FAILED("CASE B4 : EXECEPTION RAISED");
 259                END CASE_B4;
 260
 261           END CASE_B;
 262       END;
 263
 264      RESULT;
 265
 266 END C43208B;