gcc/testsuite/ada/acats/tests/cd/cd2a51a.ada

   1 -- CD2A51A.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 A
  27 --     FIXED POINT TYPE, THEN OPERATIONS ON VALUES OF SUCH A TYPE
  28 --     ARE NOT AFFECTED BY THE REPRESENTATION CLAUSE.
  29
  30 -- HISTORY:
  31 --     RJW 08/12/87  CREATED ORIGINAL TEST.
  32 --     DHH 04/12/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA', CHANGED
  33 --                   OPERATORS ON 'SIZE TESTS, AND CHANGED 'SIZE CLAUSE
  34 --                   SO THAT IT IS NOT A POWER OF TWO.
  35 --     WMC 03/31/92  ELIMINATED TEST REDUNDANCIES.
  36 --     PWN 02/02/95  REMOVED INCONSISTENCIES WITH ADA 9X.
  37
  38 WITH REPORT; USE REPORT;
  39 PROCEDURE CD2A51A IS
  40
  41      BASIC_SIZE : CONSTANT := 9;
  42
  43      TYPE BASIC_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
  44
  45      TYPE CHECK_TYPE IS DELTA 2.0 ** (-4) RANGE -4.0 .. 4.0;
  46
  47      FOR CHECK_TYPE'SIZE USE BASIC_SIZE;
  48
  49      CNEG1 : CHECK_TYPE := -3.5;
  50      CNEG2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
  51      CPOS1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
  52      CPOS2 : CHECK_TYPE :=  3.5;
  53      CZERO : CHECK_TYPE;
  54
  55      TYPE ARRAY_TYPE IS ARRAY (0 .. 3) OF CHECK_TYPE;
  56      CHARRAY : ARRAY_TYPE :=
  57           (-3.5, CHECK_TYPE (-1.0/3.0), CHECK_TYPE (4.0/6.0), 3.5);
  58
  59      TYPE REC_TYPE IS RECORD
  60           COMPN1 : CHECK_TYPE := -3.5;
  61           COMPN2 : CHECK_TYPE := CHECK_TYPE (-1.0/3.0);
  62           COMPP1 : CHECK_TYPE := CHECK_TYPE (4.0/6.0);
  63           COMPP2 : CHECK_TYPE :=  3.5;
  64      END RECORD;
  65
  66      CHREC : REC_TYPE;
  67
  68      FUNCTION IDENT (FX : CHECK_TYPE) RETURN CHECK_TYPE IS
  69      BEGIN
  70           IF EQUAL (3, 3) THEN
  71                RETURN FX;
  72           ELSE
  73                RETURN 0.0;
  74           END IF;
  75      END IDENT;
  76
  77      PROCEDURE PROC (N1_IN, P1_IN      :        CHECK_TYPE;
  78                      N2_INOUT,P2_INOUT : IN OUT CHECK_TYPE;
  79                      CZOUT             :    OUT CHECK_TYPE) IS
  80      BEGIN
  81
  82           IF +IDENT (N2_INOUT) NOT IN -0.375 .. -0.3125 OR
  83              IDENT (-P1_IN) NOT IN -0.6875 .. -0.625 THEN
  84                FAILED ("INCORRECT RESULTS FOR " &
  85                        "UNARY ADDING OPERATORS - 1");
  86           END IF;
  87
  88           IF ABS IDENT (N2_INOUT) NOT IN 0.3125 .. 0.375 OR
  89              IDENT (ABS P1_IN) NOT IN 0.625 .. 0.6875 THEN
  90                FAILED ("INCORRECT RESULTS FOR " &
  91                        "ABSOLUTE VALUE OPERATORS - 1");
  92           END IF;
  93
  94           CZOUT := 0.0;
  95
  96      END PROC;
  97
  98 BEGIN
  99      TEST ("CD2A51A", "CHECK THAT WHEN A SIZE SPECICFICATION IS " &
 100                       "GIVEN FOR A FIXED POINT TYPE, THEN " &
 101                       "OPERATIONS ON VALUES OF SUCH A TYPE ARE " &
 102                       "NOT AFFECTED BY THE REPRESENTATION CLAUSE");
 103
 104      PROC (CNEG1, CPOS1, CNEG2, CPOS2, CZERO);
 105
 106      IF IDENT (CZERO) /= 0.0 THEN
 107           FAILED ("INCORRECT VALUE FOR OUT PARAMETER");
 108      END IF;
 109
 110      IF CHECK_TYPE'LAST < IDENT (3.9375) THEN
 111           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'LAST");
 112      END IF;
 113
 114      IF CHECK_TYPE'SIZE /= IDENT_INT (BASIC_SIZE) THEN
 115           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'SIZE");
 116      END IF;
 117
 118      IF CHECK_TYPE'AFT /= BASIC_TYPE'AFT THEN
 119           FAILED ("INCORRECT VALUE FOR CHECK_TYPE'AFT");
 120      END IF;
 121
 122      IF CNEG1'SIZE < IDENT_INT (BASIC_SIZE) THEN
 123           FAILED ("INCORRECT VALUE FOR CNEG1'SIZE");
 124      END IF;
 125
 126      IF IDENT (CNEG1) + CPOS1 NOT IN -2.875 .. -2.8125 OR
 127         CPOS2  - IDENT (CPOS1) NOT IN 2.8125 .. 2.875 THEN
 128           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 2");
 129      END IF;
 130
 131      IF CHECK_TYPE (CNEG1 * IDENT (CPOS1)) NOT IN -2.4375 .. -2.1875 OR
 132         CHECK_TYPE (IDENT (CNEG2) / CPOS2) NOT IN
 133                -0.125 .. -0.0625 THEN
 134           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 2");
 135      END IF;
 136
 137      IF IDENT (CPOS1) NOT IN 0.625 .. 0.6875 OR
 138             CNEG2 IN -0.25 .. 0.0 OR
 139             IDENT (CNEG2) IN -1.0 .. -0.4375 THEN
 140           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 141                   "OPERATORS - 2");
 142      END IF;
 143
 144      IF CHARRAY (1)'SIZE < IDENT_INT (BASIC_SIZE) THEN
 145           FAILED ("INCORRECT VALUE FOR CHARRAY (1)'SIZE");
 146      END IF;
 147
 148      IF +IDENT (CHARRAY (1)) NOT IN -0.375 .. -0.3125 OR
 149         IDENT (-CHARRAY (2)) NOT IN -0.6875 .. -0.625 THEN
 150           FAILED ("INCORRECT RESULTS FOR UNARY ADDING OPERATORS - 3");
 151      END IF;
 152
 153      IF ABS IDENT (CHARRAY (1)) NOT IN 0.3125 .. 0.375 OR
 154         IDENT (ABS CHARRAY (2)) NOT IN 0.625 .. 0.6875 THEN
 155           FAILED ("INCORRECT RESULTS FOR ABSOLUTE VALUE " &
 156                   "OPERATORS - 3");
 157      END IF;
 158
 159      IF IDENT (CHARRAY (2)) NOT IN 0.625 .. 0.6875 OR
 160             CHARRAY (1) IN -0.25 .. 0.0 OR
 161             IDENT (CHARRAY (1)) IN -1.0 .. -0.4375 THEN
 162           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 163                   "OPERATORS - 3");
 164      END IF;
 165
 166      IF CHREC.COMPP1'SIZE < IDENT_INT (BASIC_SIZE) THEN
 167           FAILED ("INCORRECT VALUE FOR CHREC.COMPP1'SIZE");
 168      END IF;
 169
 170      IF IDENT (CHREC.COMPN1) + CHREC.COMPP1 NOT IN
 171              -2.875 .. -2.8125 OR
 172         CHREC.COMPP2  - IDENT (CHREC.COMPP1) NOT IN
 173              2.8125 .. 2.875 THEN
 174           FAILED ("INCORRECT RESULTS FOR BINARY ADDING OPERATORS - 4");
 175      END IF;
 176
 177      IF CHECK_TYPE (CHREC.COMPN1 * IDENT (CHREC.COMPP1)) NOT IN
 178           -2.4375 .. -2.1875 OR
 179         CHECK_TYPE (IDENT (CHREC.COMPN2) / CHREC.COMPP2) NOT IN
 180           -0.125 .. -0.0625 THEN
 181           FAILED ("INCORRECT RESULTS FOR MULTIPLYING OPERATORS - 4");
 182      END IF;
 183
 184      IF IDENT (CHREC.COMPP1) NOT IN 0.625 .. 0.6875 OR
 185             CHREC.COMPN2 IN -0.25 .. 0.0 OR
 186             IDENT (CHREC.COMPN2) IN -1.0 .. -0.4375 THEN
 187           FAILED ("INCORRECT RESULTS FOR MEMBERSHIP " &
 188                   "OPERATORS - 4");
 189      END IF;
 190
 191      RESULT;
 192
 193 END CD2A51A;