1-- CXG2005.A 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-- 26-- OBJECTIVE: 27-- Check that floating point addition and multiplication 28-- have the required accuracy. 29-- 30-- TEST DESCRIPTION: 31-- The check for the required precision is essentially a 32-- check that a guard digit is used for the operations. 33-- This test uses a generic package to check the addition 34-- and multiplication results. The 35-- generic package is instantiated with the standard FLOAT 36-- type and a floating point type for the maximum number 37-- of digits of precision. 38-- 39-- APPLICABILITY CRITERIA: 40-- This test applies only to implementations supporting the 41-- Numerics Annex. 42-- 43-- 44-- CHANGE HISTORY: 45-- 14 FEB 96 SAIC Initial Release for 2.1 46-- 16 SEP 99 RLB Repaired to avoid printing thousands of (almost) 47-- identical failure messages. 48--! 49 50-- References: 51-- 52-- Basic Concepts for Computational Software 53-- W. J. Cody 54-- Problems and Methodologies in Mathematical Software Production 55-- editors P. C. Messina and A. Murli 56-- Lecture Notes in Computer Science Vol 142 57-- Springer Verlag, 1982 58-- 59-- Software Manual for the Elementary Functions 60-- William J. Cody and William Waite 61-- Prentice-Hall, 1980 62-- 63 64with System; 65with Report; 66procedure CXG2005 is 67 Verbose : constant Boolean := False; 68 69 generic 70 type Real is digits <>; 71 package Guard_Digit_Check is 72 procedure Do_Test; 73 end Guard_Digit_Check; 74 75 package body Guard_Digit_Check is 76 -- made global so that the compiler will be more likely 77 -- to keep the values in memory instead of in higher 78 -- precision registers. 79 X, Y, Z : Real; 80 OneX : Real; 81 Eps, BN : Real; 82 83 -- special constants - not declared as constants so that 84 -- the "stored" precision will be used instead of a "register" 85 -- precision. 86 Zero : Real := 0.0; 87 One : Real := 1.0; 88 Two : Real := 2.0; 89 90 Failure_Count : Natural := 0; 91 92 procedure Thwart_Optimization is 93 -- the purpose of this procedure is to reference the 94 -- global variables used by the test so 95 -- that the compiler is not likely to keep them in 96 -- a higher precision register for their entire lifetime. 97 begin 98 if Report.Ident_Bool (False) then 99 -- never executed 100 X := X + 5.0; 101 Y := Y + 6.0; 102 Z := Z + 1.0; 103 Eps := Eps + 2.0; 104 BN := BN + 2.0; 105 OneX := X + Y; 106 One := 12.34; Two := 56.78; Zero := 90.12; 107 end if; 108 end Thwart_Optimization; 109 110 111 procedure Addition_Test is 112 begin 113 for K in 1..10 loop 114 Eps := Real (K) * Real'Model_Epsilon; 115 for N in 1.. Real'Machine_EMax - 1 loop 116 BN := Real(Real'Machine_Radix) ** N; 117 X := (One + Eps) * BN; 118 Y := (One - Eps) * BN; 119 Z := X - Y; -- true value for Z is 2*Eps*BN 120 121 if Z /= Eps*BN + Eps*BN then 122 Report.Failed ("addition check failed. K=" & 123 Integer'Image (K) & 124 " N=" & Integer'Image (N) & 125 " difference=" & Real'Image (Z - 2.0*Eps*BN) & 126 " Eps*BN=" & Real'Image (Eps*BN) ); 127 Failure_Count := Failure_Count + 1; 128 exit when Failure_Count > K*4; -- Avoid displaying dozens of messages. 129 end if; 130 end loop; 131 end loop; 132 exception 133 when others => 134 Thwart_Optimization; 135 Report.Failed ("unexpected exception in addition test"); 136 end Addition_Test; 137 138 139 procedure Multiplication_Test is 140 begin 141 X := Real (Real'Machine_Radix) ** (Real'Machine_EMax - 1); 142 OneX := One * X; 143 Thwart_Optimization; 144 if OneX /= X then 145 Report.Failed ("multiplication for large values"); 146 end if; 147 148 X := Real (Real'Machine_Radix) ** (Real'Model_EMin + 1); 149 OneX := One * X; 150 Thwart_Optimization; 151 if OneX /= X then 152 Report.Failed ("multiplication for small values"); 153 end if; 154 155 -- selection of "random" values between 1/radix and radix 156 Y := One / Real (Real'Machine_Radix); 157 Z := Real(Real'Machine_Radix) - One/Real(Real'Machine_Radix); 158 for I in 0..100 loop 159 X := Y + Real (I) / 100.0 * Z; 160 OneX := One * X; 161 Thwart_Optimization; 162 if OneX /= X then 163 Report.Failed ("multiplication for case" & Integer'Image (I)); 164 exit when Failure_Count > 40+8; -- Avoid displaying dozens of messages. 165 end if; 166 end loop; 167 exception 168 when others => 169 Thwart_Optimization; 170 Report.Failed ("unexpected exception in multiplication test"); 171 end Multiplication_Test; 172 173 174 procedure Do_Test is 175 begin 176 Addition_Test; 177 Multiplication_Test; 178 end Do_Test; 179 end Guard_Digit_Check; 180 181 package Chk_Float is new Guard_Digit_Check (Float); 182 183 -- check the floating point type with the most digits 184 type A_Long_Float is digits System.Max_Digits; 185 package Chk_A_Long_Float is new Guard_Digit_Check (A_Long_Float); 186begin 187 Report.Test ("CXG2005", 188 "Check the accuracy of floating point" & 189 " addition and multiplication"); 190 191 if Verbose then 192 Report.Comment ("checking Standard.Float"); 193 end if; 194 Chk_Float.Do_Test; 195 196 if Verbose then 197 Report.Comment ("checking a digits" & 198 Integer'Image (System.Max_Digits) & 199 " floating point type"); 200 end if; 201 Chk_A_Long_Float.Do_Test; 202 203 Report.Result; 204end CXG2005; 205