1-- C45523A.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--     FOR FLOATING POINT TYPES, IF MACHINE_OVERFLOWS IS TRUE AND
27--     EITHER THE RESULT OF MULTIPLICATION LIES OUTSIDE THE RANGE OF THE
28--     BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY ZERO, THEN
29--     CONSTRAINT_ERROR IS RAISED.  THIS TESTS
30--     DIGITS 5.
31
32
33-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
34-- ***       remove incompatibilities associated with the transition   -- 9X
35-- ***       to Ada 9X.                                                -- 9X
36-- ***                                                                 -- 9X
37
38-- HISTORY:
39--     BCB 02/09/88  CREATED ORIGINAL TEST.
40--     MRM 03/30/93  REMOVED NUMERIC_ERROR FOR 9X COMPATIBILITY
41--     KAS 11/14/95  DELETED USAGE OF 'SAFE_LARGE
42--     KAS 11/30/95  GOT IT RIGHT THIS TIME
43
44WITH REPORT; USE REPORT;
45
46PROCEDURE C45523A IS
47
48     TYPE FLT IS DIGITS 5;
49
50     F : FLT;
51
52     FUNCTION IDENT_FLT(X : FLT) RETURN FLT IS
53     BEGIN
54          IF EQUAL(3,3) THEN
55               RETURN X;
56          ELSE
57               RETURN 0.0;
58          END IF;
59     END IDENT_FLT;
60
61     FUNCTION EQUAL_FLT(ONE, TWO : FLT) RETURN BOOLEAN IS
62     BEGIN
63          RETURN ONE = TWO * FLT (IDENT_INT(1));
64     END EQUAL_FLT;
65
66BEGIN
67     TEST ("C45523A", "FOR FLOATING POINT TYPES, IF MACHINE_" &
68                      "OVERFLOWS IS TRUE AND EITHER THE RESULT OF " &
69                      "MULTIPLICATION LIES OUTSIDE THE RANGE OF THE " &
70                      "BASE TYPE, OR AN ATTEMPT IS MADE TO DIVIDE BY " &
71                      "ZERO, THEN CONSTRAINT_ERROR IS RAISED." &
72                      "THIS TESTS DIGITS 5");
73
74
75     IF FLT'MACHINE_OVERFLOWS THEN
76          BEGIN
77               F := (FLT'BASE'LAST) * IDENT_FLT (2.0);
78               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR MULTIPLICATION");
79               IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
80                    COMMENT ("DON'T OPTIMIZE F");
81               END IF;
82          EXCEPTION
83               WHEN CONSTRAINT_ERROR =>
84                    COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
85                             "MULTIPLICATION");
86               WHEN OTHERS =>
87                    FAILED ("AN EXCEPTION OTHER THAN " &
88                            "CONSTRAINT_ERROR WAS RAISED FOR " &
89                            "MULTIPLICATION");
90          END;
91          BEGIN
92               F := (FLT'LAST) / IDENT_FLT (0.0);
93               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED FOR DIVISION BY ZERO");
94               IF EQUAL_FLT(F,F**IDENT_INT(1)) THEN
95                    COMMENT ("DON'T OPTIMIZE F");
96               END IF;
97          EXCEPTION
98               WHEN CONSTRAINT_ERROR =>
99                    COMMENT ("CONSTRAINT_ERROR WAS RAISED FOR " &
100                             "DIVISION BY ZERO");
101               WHEN OTHERS =>
102                    FAILED ("AN EXCEPTION OTHER THAN CONSTRAINT_ERROR " &
103                            "WAS RAISED FOR DIVISION BY ZERO");
104          END;
105     ELSE
106          NOT_APPLICABLE ("THIS TEST IS NOT APPLICABLE DUE TO " &
107                          "MACHINE_OVERFLOWS BEING FALSE");
108     END IF;
109
110     RESULT;
111END C45523A;
112