old-autovect-branch/gcc/testsuite/ada/acats/tests/c7/c74004a.ada

   1 -- C74004A.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 -- OBJECTIVE:
  26 --     CHECK THAT OPERATIONS DEPENDING ON THE FULL DECLARATION OF A
  27 --     PRIVATE TYPE ARE AVAILABLE WITHIN THE PACKAGE BODY.
  28
  29 -- HISTORY:
  30 --     BCB 04/05/88  CREATED ORIGINAL TEST.
  31 --     PWN 01/31/95  REMOVED INCONSISTENCIES WITH ADA 9X.
  32
  33 WITH REPORT; USE REPORT;
  34
  35 PROCEDURE C74004A IS
  36
  37      PACKAGE P IS
  38           TYPE PR IS PRIVATE;
  39           TYPE ARR1 IS LIMITED PRIVATE;
  40           TYPE ARR2 IS PRIVATE;
  41           TYPE REC (D : INTEGER) IS PRIVATE;
  42           TYPE ACC IS PRIVATE;
  43           TYPE TSK IS LIMITED PRIVATE;
  44           TYPE FLT IS LIMITED PRIVATE;
  45           TYPE FIX IS LIMITED PRIVATE;
  46
  47           TASK TYPE T IS
  48                ENTRY ONE(V : IN OUT INTEGER);
  49           END T;
  50
  51           PROCEDURE CHECK (V : ARR2);
  52      PRIVATE
  53           TYPE PR IS NEW INTEGER;
  54
  55           TYPE ARR1 IS ARRAY(1..5) OF INTEGER;
  56
  57           TYPE ARR2 IS ARRAY(1..5) OF BOOLEAN;
  58
  59           TYPE REC (D : INTEGER) IS RECORD
  60                COMP1 : INTEGER;
  61                COMP2 : BOOLEAN;
  62           END RECORD;
  63
  64           TYPE ACC IS ACCESS INTEGER;
  65
  66           TYPE TSK IS NEW T;
  67
  68           TYPE FLT IS DIGITS 5;
  69
  70           TYPE FIX IS DELTA 2.0**(-1) RANGE -100.0 .. 100.0;
  71      END P;
  72
  73      PACKAGE BODY P IS
  74           X1, X2, X3 : PR;
  75           BOOL : BOOLEAN := IDENT_BOOL(FALSE);
  76           VAL : INTEGER := IDENT_INT(0);
  77           FVAL : FLOAT := 0.0;
  78           ST : STRING(1..2);
  79           O1 : ARR1 := (1,2,3,4,5);
  80           Y1 : ARR2 := (FALSE,TRUE,FALSE,TRUE,FALSE);
  81           Y2 : ARR2 := (OTHERS => TRUE);
  82           Y3 : ARR2 := (OTHERS => FALSE);
  83           Z1 : REC(0) := (0,1,FALSE);
  84           W1, W2 : ACC := NEW INTEGER'(0);
  85           V1 : TSK;
  86
  87           TASK BODY T IS
  88           BEGIN
  89                ACCEPT ONE(V : IN OUT INTEGER) DO
  90                     V := IDENT_INT(10);
  91                END ONE;
  92           END T;
  93
  94           PROCEDURE CHECK (V : ARR2) IS
  95           BEGIN
  96                IF V /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
  97                     FAILED ("IMPROPER VALUE PASSED AS AGGREGATE");
  98                END IF;
  99           END CHECK;
 100      BEGIN
 101           TEST ("C74004A", "CHECK THAT OPERATIONS DEPENDING ON THE " &
 102                            "FULL DECLARATION OF A PRIVATE TYPE ARE " &
 103                            "AVAILABLE WITHIN THE PACKAGE BODY");
 104
 105           X1 := 10;
 106           X2 := 5;
 107
 108           X3 := X1 + X2;
 109
 110           IF X3 /= 15 THEN
 111                FAILED ("IMPROPER RESULT FROM ADDITION OPERATOR");
 112           END IF;
 113
 114           X3 := X1 - X2;
 115
 116           IF X3 /= 5 THEN
 117                FAILED ("IMPROPER RESULT FROM SUBTRACTION OPERATOR");
 118           END IF;
 119
 120           X3 := X1 * X2;
 121
 122           IF X3 /= 50 THEN
 123                FAILED ("IMPROPER RESULT FROM MULTIPLICATION OPERATOR");
 124           END IF;
 125
 126           X3 := X1 / X2;
 127
 128           IF X3 /= 2 THEN
 129                FAILED ("IMPROPER RESULT FROM DIVISION OPERATOR");
 130           END IF;
 131
 132           X3 := X1 ** 2;
 133
 134           IF X3 /= 100 THEN
 135                FAILED ("IMPROPER RESULT FROM EXPONENTIATION OPERATOR");
 136           END IF;
 137
 138           BOOL := X1 < X2;
 139
 140           IF BOOL THEN
 141                FAILED ("IMPROPER RESULT FROM LESS THAN OPERATOR");
 142           END IF;
 143
 144           BOOL := X1 > X2;
 145
 146           IF NOT BOOL THEN
 147                FAILED ("IMPROPER RESULT FROM GREATER THAN OPERATOR");
 148           END IF;
 149
 150           BOOL := X1 <= X2;
 151
 152           IF BOOL THEN
 153                FAILED ("IMPROPER RESULT FROM LESS THAN OR EQUAL TO " &
 154                        "OPERATOR");
 155           END IF;
 156
 157           BOOL := X1 >= X2;
 158
 159           IF NOT BOOL THEN
 160                FAILED ("IMPROPER RESULT FROM GREATER THAN OR EQUAL " &
 161                        "TO OPERATOR");
 162           END IF;
 163
 164           X3 := X1 MOD X2;
 165
 166           IF X3 /= 0 THEN
 167                FAILED ("IMPROPER RESULT FROM MOD OPERATOR");
 168           END IF;
 169
 170           X3 := X1 REM X2;
 171
 172           IF X3 /= 0 THEN
 173                FAILED ("IMPROPER RESULT FROM REM OPERATOR");
 174           END IF;
 175
 176           X3 := ABS(X1);
 177
 178           IF X3 /= 10 THEN
 179                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 1");
 180           END IF;
 181
 182           X1 := -10;
 183
 184           X3 := ABS(X1);
 185
 186           IF X3 /= 10 THEN
 187                FAILED ("IMPROPER RESULT FROM ABS OPERATOR - 2");
 188           END IF;
 189
 190           X3 := PR'BASE'FIRST;
 191
 192           IF X3 /= PR(INTEGER'FIRST) THEN
 193                FAILED ("IMPROPER RESULT FROM 'BASE'FIRST");
 194           END IF;
 195
 196           X3 := PR'FIRST;
 197
 198           IF X3 /= PR(INTEGER'FIRST) THEN
 199                FAILED ("IMPROPER RESULT FROM 'FIRST");
 200           END IF;
 201
 202           VAL := PR'WIDTH;
 203
 204           IF NOT EQUAL(VAL,INTEGER'WIDTH) THEN
 205                FAILED ("IMPROPER RESULT FROM 'WIDTH");
 206           END IF;
 207
 208           VAL := PR'POS(X3);
 209
 210           IF NOT EQUAL(VAL,INTEGER'FIRST) THEN
 211                FAILED ("IMPROPER RESULT FROM 'POS");
 212           END IF;
 213
 214           X3 := PR'VAL(VAL);
 215
 216           IF X3 /= PR(INTEGER'FIRST) THEN
 217                FAILED ("IMPROPER RESULT FROM 'VAL");
 218           END IF;
 219
 220           X3 := PR'SUCC(X2);
 221
 222           IF X3 /= 6 THEN
 223                FAILED ("IMPROPER RESULT FROM 'SUCC");
 224           END IF;
 225
 226           X3 := PR'PRED(X2);
 227
 228           IF X3 /= 4 THEN
 229                FAILED ("IMPROPER RESULT FROM 'PRED");
 230           END IF;
 231
 232           ST := PR'IMAGE(X3);
 233
 234           IF ST /= INTEGER'IMAGE(INTEGER(X3)) THEN
 235                FAILED ("IMPROPER RESULT FROM 'IMAGE");
 236           END IF;
 237
 238           X3 := PR'VALUE(ST);
 239
 240           IF X3 /= PR(INTEGER'VALUE(ST)) THEN
 241                FAILED ("IMPROPER RESULT FROM 'VALUE");
 242           END IF;
 243
 244           CHECK ((TRUE,FALSE,TRUE,FALSE,TRUE));
 245
 246           IF O1(2) /= IDENT_INT(2) THEN
 247                FAILED ("IMPROPER VALUE FROM INDEXING");
 248           END IF;
 249
 250           IF O1(2..4) /= (2,3,4) THEN
 251                FAILED ("IMPROPER VALUES FROM SLICING");
 252           END IF;
 253
 254           IF VAL IN O1'RANGE THEN
 255                FAILED ("IMPROPER RESULT FROM 'RANGE");
 256           END IF;
 257
 258           VAL := O1'LENGTH;
 259
 260           IF NOT EQUAL(VAL,5) THEN
 261                FAILED ("IMPROPER RESULT FROM 'LENGTH");
 262           END IF;
 263
 264           Y3 := Y1(1..2) & Y2(3..5);
 265
 266           IF Y3 /= (FALSE,TRUE,TRUE,TRUE,TRUE) THEN
 267                FAILED ("IMPROPER RESULT FROM CATENATION");
 268           END IF;
 269
 270           Y3 := NOT Y1;
 271
 272           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
 273                FAILED ("IMPROPER RESULT FROM NOT OPERATOR");
 274           END IF;
 275
 276           Y3 := Y1 AND Y2;
 277
 278           IF Y3 /= (FALSE,TRUE,FALSE,TRUE,FALSE) THEN
 279                FAILED ("IMPROPER RESULT FROM AND OPERATOR");
 280           END IF;
 281
 282           Y3 := Y1 OR Y2;
 283
 284           IF Y3 /= (TRUE,TRUE,TRUE,TRUE,TRUE) THEN
 285                FAILED ("IMPROPER RESULT FROM OR OPERATOR");
 286           END IF;
 287
 288           Y3 := Y1 XOR Y2;
 289
 290           IF Y3 /= (TRUE,FALSE,TRUE,FALSE,TRUE) THEN
 291                FAILED ("IMPROPER RESULT FROM XOR OPERATOR");
 292           END IF;
 293
 294           VAL := Z1.COMP1;
 295
 296           IF NOT EQUAL(VAL,1) THEN
 297                FAILED ("IMPROPER RESULT FROM SELECTION OF RECORD " &
 298                        "COMPONENTS");
 299           END IF;
 300
 301           W1 := NEW INTEGER'(0);
 302
 303           IF NOT EQUAL(W1.ALL,0) THEN
 304                FAILED ("IMPROPER RESULT FROM ALLOCATION");
 305           END IF;
 306
 307           W1 := NULL;
 308
 309           IF W1 /= NULL THEN
 310                FAILED ("IMPROPER RESULT FROM NULL LITERAL");
 311           END IF;
 312
 313           VAL := W2.ALL;
 314
 315           IF NOT EQUAL(VAL,0) THEN
 316                FAILED ("IMPROPER RESULT FROM SELECTED COMPONENT");
 317           END IF;
 318
 319           BOOL := V1'CALLABLE;
 320
 321           IF NOT BOOL THEN
 322                FAILED ("IMPROPER RESULT FROM 'CALLABLE");
 323           END IF;
 324
 325           BOOL := V1'TERMINATED;
 326
 327           IF BOOL THEN
 328                FAILED ("IMPROPER RESULT FROM 'TERMINATED");
 329           END IF;
 330
 331           V1.ONE(VAL);
 332
 333           IF NOT EQUAL(VAL,10) THEN
 334                FAILED ("IMPROPER RESULT RETURNED FROM ENTRY SELECTION");
 335           END IF;
 336
 337           IF NOT (FLT(1.0) IN FLT) THEN
 338                FAILED ("IMPROPER RESULT FROM IMPLICIT CONVERSION");
 339           END IF;
 340
 341           VAL := FLT'DIGITS;
 342
 343           IF NOT EQUAL(VAL,5) THEN
 344                FAILED ("IMPROPER RESULT FROM 'DIGITS");
 345           END IF;
 346
 347           BOOL := FLT'MACHINE_ROUNDS;
 348
 349           BOOL := FLT'MACHINE_OVERFLOWS;
 350
 351           VAL := FLT'MACHINE_RADIX;
 352
 353           VAL := FLT'MACHINE_MANTISSA;
 354
 355           VAL := FLT'MACHINE_EMAX;
 356
 357           VAL := FLT'MACHINE_EMIN;
 358
 359           FVAL := FIX'DELTA;
 360
 361           IF FVAL /= 2.0**(-1) THEN
 362                FAILED ("IMPROPER RESULT FROM 'DELTA");
 363           END IF;
 364
 365           VAL := FIX'FORE;
 366
 367           VAL := FIX'AFT;
 368
 369      END P;
 370
 371      USE P;
 372
 373 BEGIN
 374      RESULT;
 375 END C74004A;