gcc/testsuite/ada/acats/tests/c3/c34002a.ada

   1 -- C34002A.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 REQUIRED PREDEFINED OPERATIONS ARE DECLARED
  26 -- (IMPLICITLY) FOR DERIVED INTEGER TYPES.
  27
  28 -- JRK 8/21/86
  29
  30 WITH SYSTEM; USE SYSTEM;
  31 WITH REPORT; USE REPORT;
  32
  33 PROCEDURE C34002A IS
  34
  35      TYPE PARENT IS RANGE -100 .. 100;
  36
  37      SUBTYPE SUBPARENT IS PARENT RANGE
  38                PARENT'VAL (IDENT_INT (-50)) ..
  39                PARENT'VAL (IDENT_INT ( 50));
  40
  41      TYPE T IS NEW SUBPARENT RANGE
  42                PARENT'VAL (IDENT_INT (-30)) ..
  43                PARENT'VAL (IDENT_INT ( 30));
  44
  45      TYPE FIXED IS DELTA 0.1 RANGE -1000.0 .. 1000.0;
  46
  47      X : T        := -30;
  48      W : PARENT   := -100;
  49      N : CONSTANT := 1;
  50      M : CONSTANT := 100;
  51      B : BOOLEAN  := FALSE;
  52      F : FLOAT    := 0.0;
  53      G : FIXED    := 0.0;
  54
  55      PROCEDURE A (X : ADDRESS) IS
  56      BEGIN
  57           B := IDENT_BOOL (TRUE);
  58      END A;
  59
  60      FUNCTION IDENT (X : T) RETURN T IS
  61      BEGIN
  62           IF EQUAL (T'POS (X), T'POS (X)) THEN
  63                RETURN X;                          -- ALWAYS EXECUTED.
  64           END IF;
  65           RETURN T'FIRST;
  66      END IDENT;
  67
  68 BEGIN
  69      TEST ("C34002A", "CHECK THAT THE REQUIRED PREDEFINED OPERATIONS " &
  70                       "ARE DECLARED (IMPLICITLY) FOR DERIVED " &
  71                       "INTEGER TYPES");
  72
  73      X := IDENT (30);
  74      IF X /= 30 THEN
  75           FAILED ("INCORRECT :=");
  76      END IF;
  77
  78      IF T'(X) /= 30 THEN
  79           FAILED ("INCORRECT QUALIFICATION");
  80      END IF;
  81
  82      IF T (X) /= 30 THEN
  83           FAILED ("INCORRECT SELF CONVERSION");
  84      END IF;
  85
  86      IF EQUAL (3, 3) THEN
  87           W := -30;
  88      END IF;
  89      IF T (W) /= -30 THEN
  90           FAILED ("INCORRECT CONVERSION FROM PARENT");
  91      END IF;
  92
  93      IF PARENT (X) /= 30 OR PARENT (T'VAL (-100)) /= -100 THEN
  94           FAILED ("INCORRECT CONVERSION TO PARENT");
  95      END IF;
  96
  97      IF T (IDENT_INT (-30)) /= -30 THEN
  98           FAILED ("INCORRECT CONVERSION FROM INTEGER");
  99      END IF;
 100
 101      IF INTEGER (X) /= 30 OR INTEGER (T'VAL (-100)) /= -100 THEN
 102           FAILED ("INCORRECT CONVERSION TO INTEGER");
 103      END IF;
 104
 105      IF EQUAL (3, 3) THEN
 106           F := -30.0;
 107      END IF;
 108      IF T (F) /= -30 THEN
 109           FAILED ("INCORRECT CONVERSION FROM FLOAT");
 110      END IF;
 111
 112      IF FLOAT (X) /= 30.0 OR FLOAT (T'VAL (-100)) /= -100.0 THEN
 113           FAILED ("INCORRECT CONVERSION TO FLOAT");
 114      END IF;
 115
 116      IF EQUAL (3, 3) THEN
 117           G := -30.0;
 118      END IF;
 119      IF T (G) /= -30 THEN
 120           FAILED ("INCORRECT CONVERSION FROM FIXED");
 121      END IF;
 122
 123      IF FIXED (X) /= 30.0 OR FIXED (T'VAL (-100)) /= -100.0 THEN
 124           FAILED ("INCORRECT CONVERSION TO FIXED");
 125      END IF;
 126
 127      IF IDENT (N) /= 1 OR X = M THEN
 128           FAILED ("INCORRECT IMPLICIT CONVERSION");
 129      END IF;
 130
 131      IF IDENT (30) /= 30 OR X = 100 THEN
 132           FAILED ("INCORRECT INTEGER LITERAL");
 133      END IF;
 134
 135      IF X = IDENT (0) OR X = 100 THEN
 136           FAILED ("INCORRECT =");
 137      END IF;
 138
 139      IF X /= IDENT (30) OR NOT (X /= 100) THEN
 140           FAILED ("INCORRECT /=");
 141      END IF;
 142
 143      IF X < IDENT (30) OR 100 < X THEN
 144           FAILED ("INCORRECT <");
 145      END IF;
 146
 147      IF X > IDENT (30) OR X > 100 THEN
 148           FAILED ("INCORRECT >");
 149      END IF;
 150
 151      IF X <= IDENT (0) OR 100 <= X THEN
 152           FAILED ("INCORRECT <=");
 153      END IF;
 154
 155      IF IDENT (0) >= X OR X >= 100 THEN
 156           FAILED ("INCORRECT >=");
 157      END IF;
 158
 159      IF NOT (X IN T) OR 100 IN T THEN
 160           FAILED ("INCORRECT ""IN""");
 161      END IF;
 162
 163      IF X NOT IN T OR NOT (100 NOT IN T) THEN
 164           FAILED ("INCORRECT ""NOT IN""");
 165      END IF;
 166
 167      IF +X /= 30 OR +T'VAL(-100) /= -100 THEN
 168           FAILED ("INCORRECT UNARY +");
 169      END IF;
 170
 171      IF -X /= 0 - 30 OR -T'VAL(-100) /= 100 THEN
 172           FAILED ("INCORRECT UNARY -");
 173      END IF;
 174
 175      IF ABS X /= 30 OR ABS T'VAL (-100) /= 100 THEN
 176           FAILED ("INCORRECT ABS");
 177      END IF;
 178
 179      IF X + IDENT (-1) /= 29 OR X + 70 /= 100 THEN
 180           FAILED ("INCORRECT BINARY +");
 181      END IF;
 182
 183      IF X - IDENT (30) /= 0 OR X - 100 /= -70 THEN
 184           FAILED ("INCORRECT BINARY -");
 185      END IF;
 186
 187      IF X * IDENT (-1) /= -30 OR IDENT (2) * 50 /= 100 THEN
 188           FAILED ("INCORRECT *");
 189      END IF;
 190
 191      IF X / IDENT (3) /= 10 OR 90 / X /= 3 THEN
 192           FAILED ("INCORRECT /");
 193      END IF;
 194
 195      IF X MOD IDENT (7) /= 2 OR 100 MOD X /= 10 THEN
 196           FAILED ("INCORRECT MOD");
 197      END IF;
 198
 199      IF X REM IDENT (7) /= 2 OR 100 REM X /= 10 THEN
 200           FAILED ("INCORRECT REM");
 201      END IF;
 202
 203      IF X ** IDENT_INT (1) /= 30 OR
 204         T'VAL (100) ** IDENT_INT (1) /= 100 THEN
 205           FAILED ("INCORRECT **");
 206      END IF;
 207
 208      B := FALSE;
 209      A (X'ADDRESS);
 210      IF NOT B THEN
 211           FAILED ("INCORRECT 'ADDRESS");
 212      END IF;
 213
 214      IF T'BASE'SIZE < 8 THEN
 215           FAILED ("INCORRECT 'BASE'SIZE");
 216      END IF;
 217
 218      IF T'FIRST /= -30 OR
 219         T'POS (T'BASE'FIRST) /= PARENT'POS (PARENT'BASE'FIRST) THEN
 220           FAILED ("INCORRECT 'FIRST");
 221      END IF;
 222
 223      IF T'IMAGE (X) /= " 30" OR T'IMAGE (-100) /= "-100" THEN
 224           FAILED ("INCORRECT 'IMAGE");
 225      END IF;
 226
 227      IF T'LAST /= 30 OR
 228         T'POS (T'BASE'LAST) /= PARENT'POS (PARENT'BASE'LAST) THEN
 229           FAILED ("INCORRECT 'LAST");
 230      END IF;
 231
 232      IF T'POS (X) /= 30 OR T'POS (-100) /= -100 THEN
 233           FAILED ("INCORRECT 'POS");
 234      END IF;
 235
 236      IF T'PRED (X) /= 29 OR T'PRED (100) /= 99 THEN
 237           FAILED ("INCORRECT 'PRED");
 238      END IF;
 239
 240      IF T'SIZE < 6 THEN
 241           FAILED ("INCORRECT TYPE'SIZE");
 242      END IF;
 243
 244      IF X'SIZE < 6 THEN
 245           FAILED ("INCORRECT OBJECT'SIZE");
 246      END IF;
 247
 248      IF T'SUCC (IDENT (29)) /= X OR T'SUCC (99) /= 100 THEN
 249           FAILED ("INCORRECT 'SUCC");
 250      END IF;
 251
 252      IF T'VAL (IDENT_INT (30)) /= X OR T'VAL (100) /= 100 THEN
 253           FAILED ("INCORRECT 'VAL");
 254      END IF;
 255
 256      IF T'VALUE (IDENT_STR ("30")) /= X OR T'VALUE ("100") /= 100 THEN
 257           FAILED ("INCORRECT 'VALUE");
 258      END IF;
 259
 260      IF T'WIDTH /= 3 OR T'BASE'WIDTH < 4 THEN
 261           FAILED ("INCORRECT 'WIDTH");
 262      END IF;
 263
 264      RESULT;
 265 END C34002A;