old-autovect-branch/gcc/testsuite/ada/acats/tests/c3/c34004a.ada

   1 -- C34004A.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 THE REQUIRED PREDEFINED OPERATIONS ARE DECLARED
  27 --      (IMPLICITLY) FOR DERIVED FIXED POINT TYPES.
  28
  29 -- HISTORY:
  30 --      JRK 09/08/86  CREATED ORIGINAL TEST.
  31 --      JET 08/06/87  FIXED BUGS IN DELTAS AND RANGE ERROR.
  32 --      JET 09/22/88  CHANGED USAGE OF X'SIZE.
  33 --      RDH 04/16/90  ADDED TEST FOR REAL VARIABLE VALUES.
  34 --      THS 09/25/90  REMOVED ALL REFERENCES TO B, MODIFIED CHECK OF
  35 --                    '=', INITIALIZED Z NON-STATICALLY, MOVED BINARY
  36 --                    CHECKS.
  37 --      DTN 11/30/95  REMOVED NON ADA95 ATTRIBUTES.
  38 --      KAS 03/04/96  REMOVED COMPARISON OF T'SMALL TO T'BASE'SMALL
  39
  40 WITH SYSTEM; USE SYSTEM;
  41 WITH REPORT; USE REPORT;
  42
  43 PROCEDURE C34004A IS
  44
  45      TYPE PARENT IS DELTA 2.0 ** (-7) RANGE -100.0 .. 100.0;
  46
  47      SUBTYPE SUBPARENT IS PARENT RANGE
  48                IDENT_INT (1) * (-50.0) ..
  49                IDENT_INT (1) * ( 50.0);
  50
  51      TYPE T IS NEW SUBPARENT DELTA 2.0 ** (-4) RANGE
  52                IDENT_INT (1) * (-30.0) ..
  53                IDENT_INT (1) * ( 30.0);
  54
  55      TYPE FIXED IS DELTA 2.0 ** (-4) RANGE -1000.0 .. 1000.0;
  56
  57      X : T        := -30.0;
  58      I : INTEGER  := X'SIZE;  --CHECK FOR THE AVAILABILITY OF 'SIZE.
  59      W : PARENT   := -100.0;
  60      R : CONSTANT := 1.0;
  61      M : CONSTANT := 100.0;
  62      F : FLOAT    := 0.0;
  63      G : FIXED    := 0.0;
  64
  65      PROCEDURE A (X : ADDRESS) IS
  66      BEGIN
  67           NULL;
  68      END A;
  69
  70      FUNCTION IDENT (X : T) RETURN T IS
  71      BEGIN
  72           IF EQUAL (3, 3) THEN
  73                RETURN X;                          -- ALWAYS EXECUTED.
  74           END IF;
  75           RETURN T'FIRST;
  76      END IDENT;
  77
  78 BEGIN
  79
  80      DECLARE
  81           Z : CONSTANT T := IDENT(0.0);
  82      BEGIN
  83           TEST ("C34004A", "CHECK THAT THE REQUIRED PREDEFINED " &
  84                            "OPERATIONS ARE DECLARED (IMPLICITLY) " &
  85                            "FOR DERIVED FIXED POINT TYPES");
  86
  87           X := IDENT (30.0);
  88           IF X /= 30.0 THEN
  89                FAILED ("INCORRECT :=");
  90           END IF;
  91
  92           IF X + IDENT (-1.0) /= 29.0 OR X + 70.0 /= 100.0 THEN
  93                FAILED ("INCORRECT BINARY +");
  94           END IF;
  95
  96           IF X - IDENT (30.0) /= 0.0 OR X - 100.0 /= -70.0 THEN
  97                FAILED ("INCORRECT BINARY -");
  98           END IF;
  99
 100           IF T'(X) /= 30.0 THEN
 101                FAILED ("INCORRECT QUALIFICATION");
 102           END IF;
 103
 104           IF T (X) /= 30.0 THEN
 105                FAILED ("INCORRECT SELF CONVERSION");
 106           END IF;
 107
 108           IF EQUAL (3, 3) THEN
 109                W := -30.0;
 110           END IF;
 111           IF T (W) /= -30.0 THEN
 112                FAILED ("INCORRECT CONVERSION FROM PARENT");
 113           END IF;
 114
 115           IF PARENT (X) /= 30.0 OR PARENT (Z - 100.0) /= -100.0 THEN
 116                FAILED ("INCORRECT CONVERSION TO PARENT");
 117           END IF;
 118
 119           IF T (IDENT_INT (-30)) /= -30.0 THEN
 120                FAILED ("INCORRECT CONVERSION FROM INTEGER");
 121           END IF;
 122
 123           IF INTEGER (X) /= 30 OR INTEGER (Z - 100.0) /= -100 THEN
 124                FAILED ("INCORRECT CONVERSION TO INTEGER");
 125           END IF;
 126
 127           IF EQUAL (3, 3) THEN
 128                F := -30.0;
 129           END IF;
 130           IF T (F) /= -30.0 THEN
 131                FAILED ("INCORRECT CONVERSION FROM FLOAT");
 132           END IF;
 133
 134           IF FLOAT (X) /= 30.0 OR FLOAT (Z - 100.0) /= -100.0 THEN
 135                FAILED ("INCORRECT CONVERSION TO FLOAT");
 136           END IF;
 137
 138           IF EQUAL (3, 3) THEN
 139                G := -30.0;
 140           END IF;
 141           IF T (G) /= -30.0 THEN
 142                FAILED ("INCORRECT CONVERSION FROM FIXED");
 143           END IF;
 144
 145           IF FIXED (X) /= 30.0 OR FIXED (Z - 100.0) /= -100.0 THEN
 146                FAILED ("INCORRECT CONVERSION TO FIXED");
 147           END IF;
 148
 149           IF IDENT (R) /= 1.0 OR X = M THEN
 150                FAILED ("INCORRECT IMPLICIT CONVERSION");
 151           END IF;
 152
 153           IF IDENT (30.0) /= 30.0 OR X = 100.0 THEN
 154                FAILED ("INCORRECT REAL LITERAL");
 155           END IF;
 156
 157           IF NOT (X = IDENT (30.0)) THEN
 158                FAILED ("INCORRECT =");
 159           END IF;
 160
 161           IF X /= IDENT (30.0) OR NOT (X /= 100.0) THEN
 162                FAILED ("INCORRECT /=");
 163           END IF;
 164
 165           IF X < IDENT (30.0) OR 100.0 < X THEN
 166                FAILED ("INCORRECT <");
 167           END IF;
 168
 169           IF X > IDENT (30.0) OR X > 100.0 THEN
 170                FAILED ("INCORRECT >");
 171           END IF;
 172
 173           IF X <= IDENT (0.0) OR 100.0 <= X THEN
 174                FAILED ("INCORRECT <=");
 175           END IF;
 176
 177           IF IDENT (0.0) >= X OR X >= 100.0 THEN
 178                FAILED ("INCORRECT >=");
 179           END IF;
 180
 181           IF NOT (X IN T) OR 100.0 IN T THEN
 182                FAILED ("INCORRECT ""IN""");
 183           END IF;
 184
 185           IF X NOT IN T OR NOT (100.0 NOT IN T) THEN
 186                FAILED ("INCORRECT ""NOT IN""");
 187           END IF;
 188
 189           IF +X /= 30.0 OR +(Z - 100.0) /= -100.0 THEN
 190                FAILED ("INCORRECT UNARY +");
 191           END IF;
 192
 193           IF -X /= 0.0 - 30.0 OR -(Z - 100.0) /= 100.0 THEN
 194                FAILED ("INCORRECT UNARY -");
 195           END IF;
 196
 197           IF ABS X /= 30.0 OR ABS (Z - 100.0) /= 100.0 THEN
 198                FAILED ("INCORRECT ABS");
 199           END IF;
 200
 201           IF T (X * IDENT (-1.0)) /= -30.0 OR
 202              T (IDENT (2.0) * (Z + 15.0)) /= 30.0 THEN
 203                FAILED ("INCORRECT * (FIXED, FIXED)");
 204           END IF;
 205
 206           IF X * IDENT_INT (-1) /= -30.0 OR
 207              (Z + 50.0) * 2 /= 100.0 THEN
 208                FAILED ("INCORRECT * (FIXED, INTEGER)");
 209           END IF;
 210
 211           IF IDENT_INT (-1) * X /= -30.0 OR
 212              2 * (Z + 50.0) /= 100.0 THEN
 213                FAILED ("INCORRECT * (INTEGER, FIXED)");
 214           END IF;
 215
 216           IF T (X / IDENT (3.0)) /= 10.0 OR
 217              T ((Z + 90.0) / X) /= 3.0 THEN
 218                FAILED ("INCORRECT / (FIXED, FIXED)");
 219           END IF;
 220
 221           IF X / IDENT_INT (3) /= 10.0 OR (Z + 90.0) / 30 /= 3.0 THEN
 222                FAILED ("INCORRECT / (FIXED, INTEGER)");
 223           END IF;
 224
 225           A (X'ADDRESS);
 226
 227           IF T'AFT /= 2 OR T'BASE'AFT < 3 THEN
 228                FAILED ("INCORRECT 'AFT");
 229           END IF;
 230
 231           IF T'BASE'SIZE < 15 THEN
 232                FAILED ("INCORRECT 'BASE'SIZE");
 233           END IF;
 234
 235           IF T'DELTA /= 2.0 ** (-4) OR T'BASE'DELTA > 2.0 ** (-7) THEN
 236                FAILED ("INCORRECT 'DELTA");
 237           END IF;
 238
 239
 240           IF T'FORE /= 3 OR T'BASE'FORE < 4 THEN
 241                FAILED ("INCORRECT 'FORE");
 242           END IF;
 243
 244
 245
 246           IF T'MACHINE_OVERFLOWS /= T'BASE'MACHINE_OVERFLOWS THEN
 247                FAILED ("INCORRECT 'MACHINE_OVERFLOWS");
 248           END IF;
 249
 250           IF T'MACHINE_ROUNDS /= T'BASE'MACHINE_ROUNDS THEN
 251                FAILED ("INCORRECT 'MACHINE_ROUNDS");
 252           END IF;
 253
 254
 255
 256
 257           IF T'SIZE < 10 THEN
 258                FAILED ("INCORRECT TYPE'SIZE");
 259           END IF;
 260
 261           IF T'SMALL > 2.0 ** (-4) OR T'BASE'SMALL > 2.0 ** (-7) THEN
 262                FAILED ("INCORRECT 'SMALL");
 263           END IF;
 264      END;
 265
 266      RESULT;
 267 END C34004A;