old-autovect-branch/gcc/testsuite/ada/acats/tests/cd/cd2a32e.ada

   1 -- CD2A32E.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 WHEN A SIZE SPECIFICATION IS GIVEN FOR AN
  27 --     INTEGER TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
  28 --     WITH THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE NOT
  29 --     AFFECTED BY THE REPRESENTATION CLAUSE.
  30
  31 -- HISTORY:
  32 --     JET 08/12/87  CREATED ORIGINAL TEST.
  33 --     DHH 04/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
  34 --                   SIZE CLAUSE VALUE TO 7, AND CHANGED OPERATOR ON
  35 --                   'SIZE CHECKS.
  36 --     JRL 03/27/92  ELIMINATED REDUNDANT TESTING.
  37
  38 WITH REPORT;  USE REPORT;
  39 PROCEDURE CD2A32E IS
  40
  41      BASIC_SIZE : CONSTANT := 7;
  42
  43      TYPE INT IS RANGE 0 .. 126;
  44
  45      FOR INT'SIZE USE BASIC_SIZE;
  46
  47      I0 : INT :=   0;
  48      I1 : INT :=  63;
  49      I2 : INT := 126;
  50
  51      TYPE ARRAY_TYPE IS ARRAY (INTEGER RANGE 0 .. 2) OF INT;
  52      INTARRAY : ARRAY_TYPE := (0, 63, 126);
  53
  54      TYPE REC_TYPE IS RECORD
  55           COMP0 : INT :=   0;
  56           COMP1 : INT := 63;
  57           COMP2 : INT := 126;
  58      END RECORD;
  59
  60      IREC : REC_TYPE;
  61
  62      FUNCTION IDENT (I : INT) RETURN INT IS
  63      BEGIN
  64           IF EQUAL (0,0) THEN
  65                RETURN I;
  66           ELSE
  67                RETURN 0;
  68           END IF;
  69      END IDENT;
  70
  71      PROCEDURE PROC (PI0,  PI2  :        INT;
  72                      PIO1, PIO2 : IN OUT INT;
  73                      PO2        :    OUT INT) IS
  74
  75      BEGIN
  76           IF PI0'SIZE < IDENT_INT (BASIC_SIZE) THEN
  77                FAILED ("INCORRECT VALUE FOR PI0'SIZE");
  78           END IF;
  79
  80           IF NOT ((PI0 < IDENT (1))             AND
  81                   (IDENT (PI2) > IDENT (PIO1))  AND
  82                   (PIO1 <= IDENT (63))         AND
  83                   (IDENT (126) = PI2))          THEN
  84                FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
  85                        "OPERATORS - 1");
  86           END IF;
  87
  88           IF NOT (((PI0 + PI2)   = PIO2)        AND
  89                   ((PI2 - PIO1)  = PIO1)        AND
  90                   ((PIO1 * IDENT (2)) = PI2)    AND
  91                   ((PIO2 / PIO1) = IDENT (2))   AND
  92                   ((PIO1 ** 1)   = IDENT (63))  AND
  93                   ((PIO2 REM 10)  = IDENT (6))  AND
  94                   ((PIO1 MOD 10)  = IDENT (3))) THEN
  95                FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
  96                        "OPERATORS - 1");
  97           END IF;
  98
  99           IF INT'POS (PI0)  /= IDENT_INT (0)   OR
 100              INT'POS (PIO1) /= IDENT_INT (63) OR
 101              INT'POS (PI2)  /= IDENT_INT (126) THEN
 102                FAILED ("INCORRECT VALUE FOR INT'POS - 1");
 103           END IF;
 104
 105           IF INT'SUCC (PI0)  /= IDENT (1)   OR
 106              INT'SUCC (PIO1) /= IDENT (64) THEN
 107                FAILED ("INCORRECT VALUE FOR INT'SUCC - 1");
 108           END IF;
 109
 110           IF INT'IMAGE (PI0)  /= IDENT_STR (" 0")   OR
 111              INT'IMAGE (PIO1) /= IDENT_STR (" 63") OR
 112              INT'IMAGE (PI2)  /= IDENT_STR (" 126") THEN
 113                FAILED ("INCORRECT VALUE FOR INT'IMAGE - 1");
 114           END IF;
 115
 116           PO2 := 126;
 117
 118      END PROC;
 119
 120 BEGIN
 121      TEST ("CD2A32E", "CHECK THAT WHEN A SIZE SPECIFICATION IS " &
 122                       "GIVEN FOR AN INTEGER TYPE, THEN " &
 123                       "OPERATIONS ON VALUES OF SUCH A TYPE WITH " &
 124                       "THE SMALLEST APPROPRIATE UNSIGNED SIZE ARE " &
 125                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
 126
 127      PROC (0, 126, I1, I2, I2);
 128
 129      IF INT'SIZE /= IDENT_INT (BASIC_SIZE) THEN
 130           FAILED ("INCORRECT VALUE FOR INT'SIZE");
 131      END IF;
 132
 133      IF I1'SIZE < IDENT_INT (BASIC_SIZE) THEN
 134           FAILED ("INCORRECT VALUE FOR I1'SIZE");
 135      END IF;
 136
 137      FOR I IN IDENT (I0) .. IDENT (I2) LOOP
 138           IF NOT (I IN I0 .. I2) OR
 139              (I NOT IN IDENT(0) .. IDENT(126)) THEN
 140                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 141                        "OPERATORS - 2");
 142           END IF;
 143      END LOOP;
 144
 145      IF NOT ((+I2 = I2)     AND
 146              (-I1 = -63)   AND
 147              (ABS I2 = I2)) THEN
 148           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
 149                   "OPERATORS - 2");
 150      END IF;
 151
 152      IF INT'VAL (0)   /= IDENT (I0) OR
 153         INT'VAL (63) /= IDENT (I1) OR
 154         INT'VAL (126) /= IDENT (I2) THEN
 155           FAILED ("INCORRECT VALUE FOR INT'VAL - 2");
 156      END IF;
 157
 158      IF INT'PRED (I1) /= IDENT (62)  OR
 159         INT'PRED (I2) /= IDENT (125) THEN
 160           FAILED ("INCORRECT VALUE FOR INT'PRED - 2");
 161      END IF;
 162
 163      IF INT'VALUE ("0")   /= IDENT (I0) OR
 164         INT'VALUE ("63") /= IDENT (I1) OR
 165         INT'VALUE ("126") /= IDENT (I2) THEN
 166           FAILED ("INCORRECT VALUE FOR INT'VALUE - 2");
 167      END IF;
 168
 169      IF INTARRAY(1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
 170           FAILED ("INCORRECT VALUE FOR INTARRAY(1)'SIZE");
 171      END IF;
 172
 173      IF NOT ((INTARRAY(0) < IDENT (1))                   AND
 174              (IDENT (INTARRAY(2)) > IDENT (INTARRAY(1))) AND
 175              (INTARRAY(1) <= IDENT (63))                AND
 176              (IDENT (126) = INTARRAY(2)))                THEN
 177           FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
 178                   "OPERATORS - 3");
 179      END IF;
 180
 181      FOR I IN IDENT (INTARRAY(0)) .. IDENT (INTARRAY(2)) LOOP
 182           IF NOT (I IN INTARRAY(0) .. INTARRAY(2)) OR
 183              (I NOT IN IDENT(0) .. IDENT(126))     THEN
 184                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 185                        "OPERATORS - 3");
 186           END IF;
 187      END LOOP;
 188
 189      IF NOT (((INTARRAY(0) + INTARRAY(2))  = INTARRAY(2)) AND
 190              ((INTARRAY(2) - INTARRAY(1))  = INTARRAY(1)) AND
 191              ((INTARRAY(1) * IDENT (2))    = INTARRAY(2)) AND
 192              ((INTARRAY(2) / INTARRAY(1))  = IDENT (2))   AND
 193              ((INTARRAY(1) ** 1)           = IDENT (63))  AND
 194              ((INTARRAY(2) REM 10)         = IDENT (6))   AND
 195              ((INTARRAY(1) MOD 10)         = IDENT (3)))  THEN
 196           FAILED ("INCORRECT RESULTS FOR BINARY ARITHMETIC " &
 197                   "OPERATORS - 3");
 198      END IF;
 199
 200      IF INT'POS (INTARRAY(0)) /= IDENT_INT (0)   OR
 201         INT'POS (INTARRAY(1)) /= IDENT_INT (63) OR
 202         INT'POS (INTARRAY(2)) /= IDENT_INT (126) THEN
 203           FAILED ("INCORRECT VALUE FOR INT'POS - 3");
 204      END IF;
 205
 206      IF INT'SUCC (INTARRAY(0)) /= IDENT (1)   OR
 207         INT'SUCC (INTARRAY(1)) /= IDENT (64) THEN
 208           FAILED ("INCORRECT VALUE FOR INT'SUCC - 3");
 209      END IF;
 210
 211      IF INT'IMAGE (INTARRAY(0)) /= IDENT_STR (" 0")   OR
 212         INT'IMAGE (INTARRAY(1)) /= IDENT_STR (" 63") OR
 213         INT'IMAGE (INTARRAY(2)) /= IDENT_STR (" 126") THEN
 214           FAILED ("INCORRECT VALUE FOR INT'IMAGE - 3");
 215      END IF;
 216
 217      IF IREC.COMP2'SIZE < IDENT_INT (BASIC_SIZE) THEN
 218           FAILED ("INCORRECT VALUE FOR IREC.COMP2'SIZE");
 219      END IF;
 220
 221      IF NOT ((IREC.COMP0 < IDENT (1))                  AND
 222              (IDENT (IREC.COMP2) > IDENT (IREC.COMP1)) AND
 223              (IREC.COMP1 <= IDENT (63))               AND
 224              (IDENT (126) = IREC.COMP2))               THEN
 225           FAILED ("INCORRECT RESULTS FOR RELATIONAL " &
 226                   "OPERATORS - 4");
 227      END IF;
 228
 229      FOR I IN IDENT (IREC.COMP0) .. IDENT (IREC.COMP2) LOOP
 230           IF NOT (I IN IREC.COMP0 .. IREC.COMP2) OR
 231              (I NOT IN IDENT(0) .. IDENT(126))   THEN
 232                FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 233                        "OPERATORS - 4");
 234           END IF;
 235      END LOOP;
 236
 237      IF NOT ((+IREC.COMP2 = IREC.COMP2)     AND
 238              (-IREC.COMP1 = -63)           AND
 239              (ABS IREC.COMP2 = IREC.COMP2)) THEN
 240           FAILED ("INCORRECT RESULTS FOR UNARY ARITHMETIC " &
 241                   "OPERATORS - 4");
 242      END IF;
 243
 244      IF INT'VAL (0)   /= IDENT (IREC.COMP0) OR
 245         INT'VAL (63) /= IDENT (IREC.COMP1) OR
 246         INT'VAL (126) /= IDENT (IREC.COMP2) THEN
 247           FAILED ("INCORRECT VALUE FOR INT'VAL - 4");
 248      END IF;
 249
 250      IF INT'PRED (IREC.COMP1) /= IDENT (62)  OR
 251         INT'PRED (IREC.COMP2) /= IDENT (125) THEN
 252           FAILED ("INCORRECT VALUE FOR INT'PRED - 4");
 253      END IF;
 254
 255      IF INT'VALUE ("0")   /= IDENT (IREC.COMP0) OR
 256         INT'VALUE ("63") /= IDENT (IREC.COMP1) OR
 257         INT'VALUE ("126") /= IDENT (IREC.COMP2) THEN
 258           FAILED ("INCORRECT VALUE FOR INT'VALUE - 4");
 259      END IF;
 260
 261      RESULT;
 262
 263 END CD2A32E;