3 -- Grant of Unlimited Rights
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
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.
26 -- FOUNDATION DESCRIPTION:
27 -- This foundation package contains constants and a function used in
28 -- the evaluation of the Generic Elementary Functions.
31 -- 06 Mar 95 SAIC Initial prerelease version.
32 -- 03 Apr 95 SAIC Corrected error in context clause.
33 -- 12 Jun 95 SAIC Added procedure Dont_Optimize. Added New_Float
34 -- type, and overload of function
35 -- Result_Within_Range.
46 Epsilon
: constant Float := Float'Model_Epsilon;
47 Small
: constant Float := Float'Model_Small;
48 Large
: constant Float := Float'Safe_Last;
49 Minus_Large
: constant Float := Float'Safe_First;
51 Half_Pi
: constant Float := Ada
.Numerics
.Pi
/ 2.0;
52 Two_Pi
: constant Float := Ada
.Numerics
.Pi
* 2.0;
54 Floating_Delta
: constant Float := 0.05;
55 One_Plus_Delta
: constant Float := 1.0 + Floating_Delta
;
56 One_Minus_Delta
: constant Float := 1.0 - Floating_Delta
;
57 Minus_One_Plus_Delta
: constant Float := -1.0 + Floating_Delta
;
58 Minus_One_Minus_Delta
: constant Float := -1.0 - Floating_Delta
;
61 type New_Float
is new Float digits 6;
63 function Result_Within_Range
(Result
: Float;
64 Expected_Result
: Float;
65 Relative_Error
: Float) return Boolean;
67 function Result_Within_Range
(Result
: New_Float
;
68 Expected_Result
: Float;
69 Relative_Error
: Float) return Boolean;
71 -- This procedure is designed to defeat optimization attempts by an
72 -- implementation in cases where an exception is specifically raised
73 -- in a test to test a prescribed exception result condition.
74 -- The parameter Num is a unique identifier for location purposes within
78 type Eval_Type
is digits <>;
79 procedure Dont_Optimize
(Check_Result
: Eval_Type
;
86 package body FXA5A00
is
89 function Result_Within_Range
(Result
: Float;
90 Expected_Result
: Float;
91 Relative_Error
: Float) return Boolean is
93 return (Result
<= Expected_Result
+ Relative_Error
) and
94 (Result
>= Expected_Result
- Relative_Error
);
95 end Result_Within_Range
;
98 function Result_Within_Range
(Result
: New_Float
;
99 Expected_Result
: Float;
100 Relative_Error
: Float) return Boolean is
102 return (Float(Result
) <= Expected_Result
+ Relative_Error
) and
103 (Float(Result
) >= Expected_Result
- Relative_Error
);
104 end Result_Within_Range
;
107 procedure Dont_Optimize
(Check_Result
: Eval_Type
;
110 -- Note that the use of Minus_Large here is simply as a "dummy" value,
111 -- designed to indicate use of the Check_Result parameter, and has no
112 -- pass/fail significance to any test using this procedure.
114 if Float(Check_Result
) = Minus_Large
then
115 Report
.Comment
("Attempted Defeat of Optimization ONLY -- Not " &
116 "a cause for test failure! " &
117 "Result = Minus_Large, Case:" & Integer'Image(Num
));