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
40WITH REPORT, SYSTEM; USE REPORT;
41PROCEDURE C45242B IS
42
43BEGIN
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
148END C45242B;
149