gcc/testsuite/ada/acats/tests/c4/c45242b.ada

   1 -- C45242B.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 NO EXCEPTION IS RAISED WHEN A FLOATING POINT LITERAL
  27 --     OPERAND IN A COMPARISON OR A FLOATING POINT LITERAL LEFT OPERAND
  28 --     IN A MEMBERSHIP TEST BELONGS TO THE BASE TYPE BUT IS OUTSIDE
  29 --     THE RANGE OF THE SUBTYPE.
  30
  31 -- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
  32 -- ***       remove incompatibilities associated with the transition   -- 9X
  33 -- ***       to Ada 9X.                                                -- 9X
  34
  35 -- HISTORY:
  36 --     PWB 09/04/86 CREATED ORIGINAL TEST.
  37 --     DHH 10/19/87 SHORTENED LINES CONTAINING MORE THAN 72 CHARACTERS.
  38 --     JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
  39
  40 WITH REPORT, SYSTEM; USE REPORT;
  41 PROCEDURE C45242B IS
  42
  43 BEGIN
  44
  45      TEST ("C45242B", "NO EXCEPTION IS RAISED WHEN A FLOATING " &
  46                       "LITERAL USED IN A COMPARISON OR AS THE " &
  47                       "LEFT OPERAND IN A MEMBERSHIP TEST " &
  48                       "BELONGS TO THE BASE TYPE BUT IS OUTSIDE " &
  49                       "THE RANGE OF THE SUBTYPE");
  50
  51      DECLARE
  52           N : FLOAT := FLOAT (IDENT_INT (1));
  53           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
  54           NUM : FLOAT_1 := N;
  55      BEGIN    -- PRE-DEFINED FLOAT COMPARISON
  56
  57           IF EQUAL(3,3) THEN
  58                NUM := FLOAT_1'(0.5);
  59           END IF;
  60
  61           IF 2.0 > NUM THEN
  62                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
  63                         "COMPARISON");
  64           ELSE
  65                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
  66                        "COMPARISON");
  67           END IF;
  68      EXCEPTION
  69           WHEN CONSTRAINT_ERROR =>
  70                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
  71                        "FLOAT COMPARISON");
  72           WHEN OTHERS =>
  73                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
  74                        "FLOAT COMPARISON");
  75      END;  -- PRE-DEFINED FLOAT COMPARISON
  76
  77      DECLARE
  78           N : FLOAT := FLOAT (IDENT_INT (1));
  79           SUBTYPE FLOAT_1 IS FLOAT RANGE -1.0 .. N;
  80      BEGIN    -- PRE-DEFINED FLOAT MEMBERSHIP
  81
  82           IF 2.0 IN FLOAT_1 THEN
  83                FAILED ("WRONG RESULT FROM PRE-DEFINED FLOAT " &
  84                        "MEMBERSHIP");
  85           ELSE
  86                COMMENT ("NO EXCEPTION RAISED FOR PRE-DEFINED FLOAT " &
  87                         "MEMBERSHIP");
  88           END IF;
  89      EXCEPTION
  90           WHEN CONSTRAINT_ERROR =>
  91                FAILED ("CONSTRAINT_ERROR RAISED FOR PRE-DEFINED " &
  92                        "FLOAT MEMBERSHIP");
  93           WHEN OTHERS =>
  94                FAILED ("OTHER EXCEPTION RAISED FOR PRE-DEFINED " &
  95                        "FLOAT MEMBERSHIP");
  96      END;  -- PRE-DEFINED FLOAT MEMBERSHIP
  97
  98      DECLARE -- PRECISE FLOAT COMPARISON
  99           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
 100           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
 101           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
 102           NUM : SUB_FINE := N;
 103      BEGIN
 104           IF EQUAL(3,3) THEN
 105                NUM := 0.25;
 106           END IF;
 107
 108           IF 0.75 > NUM THEN
 109                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
 110                         "COMPARISON");
 111           ELSE
 112                FAILED ("WRONG RESULT FROM FINE_FLOAT COMPARISON");
 113           END IF;
 114
 115      EXCEPTION
 116           WHEN CONSTRAINT_ERROR =>
 117                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
 118                        "FINE_FLOAT COMPARISON");
 119           WHEN OTHERS =>
 120                FAILED ("OTHER EXCEPTION RAISED FOR  " &
 121                        "FINE_FLOAT COMPARISON");
 122      END;  --  FINE_FLOAT COMPARISON
 123
 124      DECLARE -- PRECISE FLOAT MEMBERSHIP
 125           TYPE FINE_FLOAT IS DIGITS SYSTEM.MAX_DIGITS;
 126           N : FINE_FLOAT := 0.5 * FINE_FLOAT (IDENT_INT (1));
 127           SUBTYPE SUB_FINE IS FINE_FLOAT RANGE -0.5 .. N;
 128      BEGIN
 129
 130           IF 0.75 IN SUB_FINE THEN
 131                FAILED ("WRONG RESULT FROM FINE_FLOAT MEMBERSHIP");
 132           ELSE
 133                COMMENT ("NO EXCEPTION RAISED FOR FINE_FLOAT " &
 134                         "MEMBERSHIP");
 135           END IF;
 136
 137      EXCEPTION
 138           WHEN CONSTRAINT_ERROR =>
 139                FAILED ("CONSTRAINT_ERROR RAISED FOR " &
 140                        "FINE_FLOAT MEMBERSHIP");
 141           WHEN OTHERS =>
 142                FAILED ("OTHER EXCEPTION RAISED FOR  " &
 143                        "FINE_FLOAT MEMBERSHIP");
 144      END;  --  FINE_FLOAT MEMBERSHIP
 145
 146      RESULT;
 147
 148 END C45242B;