1-- C455001.A 2 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and 6-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the 7-- software and documentation contained herein. Unlimited rights are 8-- defined in DFAR 252.227-7013(a)(19). By making this public release, 9-- the Government intends to confer upon all recipients unlimited rights 10-- equal to those held by the Government. These rights include rights to 11-- use, duplicate, release or disclose the released technical data and 12-- computer software in whole or in part, in any manner and for any purpose 13-- whatsoever, and to have or permit others to do so. 14-- 15-- DISCLAIMER 16-- 17-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 18-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 19-- WARRANTY AS TO ANY MATTER WHATSOVER, INCLUDING THE CONDITIONS OF THE 20-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 21-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 22-- PARTICULAR PURPOSE OF SAID MATERIAL. 23--* 24-- 25-- OBJECTIVE: 26-- Check that universal fixed multiplying operators can be used without 27-- a conversion in contexts where the result type is determined. 28-- 29-- Note: This is intended to check the changes made to these operators 30-- in Ada 95; legacy tests should cover cases from Ada 83. 31-- 32-- CHANGE HISTORY: 33-- 18 MAR 99 RLB Initial version 34-- 35--! 36 37with Report; use Report; 38 39procedure C455001 is 40 41 type F1 is delta 2.0**(-1) range 0.0 .. 8.0; 42 43 type F2 is delta 2.0**(-2) range 0.0 .. 4.0; 44 45 type F3 is delta 2.0**(-3) range 0.0 .. 2.0; 46 47 A : F1; 48 B : F2; 49 C : F3; 50 51 type Fixed_Record is record 52 D : F1; 53 E : F2; 54 end record; 55 56 R : Fixed_Record; 57 58 function Ident_Fix (X : F3) return F3 is 59 begin 60 if Equal(3,3) then 61 return X; 62 else 63 return 0.0; 64 end if; 65 end Ident_Fix; 66 67begin 68 Test ("C455001", "Check that universal fixed multiplying operators " & 69 "can be used without a conversion in contexts where " & 70 "the result type is determined."); 71 72 A := 1.0; B := 1.0; 73 C := A * B; -- Assignment context. 74 75 if C /= Ident_Fix(1.0) then 76 Failed ("Incorrect results for multiplication (1) - result is " & 77 F3'Image(C)); 78 end if; 79 80 C := A / B; 81 82 if C /= Ident_Fix(1.0) then 83 Failed ("Incorrect results for division (1) - result is " & 84 F3'Image(C)); 85 end if; 86 87 A := 2.5; 88 C := A * 0.25; 89 90 if C /= Ident_Fix(0.625) then 91 Failed ("Incorrect results for multiplication (2) - result is " & 92 F3'Image(C)); 93 end if; 94 95 C := A / 4.0; 96 97 if C /= Ident_Fix(0.625) then 98 Failed ("Incorrect results for division (2) - result is " & 99 F3'Image(C)); 100 end if; 101 102 C := Ident_Fix(0.75); 103 C := C * 0.5; 104 105 if C /= Ident_Fix(0.375) then 106 Failed ("Incorrect results for multiplication (3) - result is " & 107 F3'Image(C)); 108 end if; 109 110 C := Ident_Fix(0.75); 111 C := C / 0.5; 112 113 if C /= Ident_Fix(1.5) then 114 Failed ("Incorrect results for division (3) - result is " & 115 F3'Image(C)); 116 end if; 117 118 A := 0.5; B := 0.3; -- Function parameter context. 119 if Ident_Fix(A * B) not in Ident_Fix(0.125) .. Ident_Fix(0.25) then 120 Failed ("Incorrect results for multiplication (4) - result is " & 121 F3'Image(A * B)); -- Exact = 0.15 122 end if; 123 124 B := 0.8; 125 if Ident_Fix(A / B) not in Ident_Fix(0.5) .. Ident_Fix(0.75) then 126 Failed ("Incorrect results for division (4) - result is " & 127 F3'Image(A / B)); 128 -- Exact = 0.625..., but B is only restricted to the range 129 -- 0.75 .. 1.0, so the result can be anywhere in the range 130 -- 0.5 .. 0.75. 131 end if; 132 133 C := 0.875; B := 1.5; 134 R := (D => C * 4.0, E => B / 0.5); -- Aggregate context. 135 136 if R.D /= 3.5 then 137 Failed ("Incorrect results for multiplication (5) - result is " & 138 F1'Image(R.D)); 139 end if; 140 141 if R.E /= 3.0 then 142 Failed ("Incorrect results for division (5) - result is " & 143 F2'Image(R.E)); 144 end if; 145 146 A := 0.5; 147 C := A * F1'(B * 2.0); -- Qualified expression context. 148 149 if C /= Ident_Fix(1.5) then 150 Failed ("Incorrect results for multiplication (6) - result is " & 151 F3'Image(C)); 152 end if; 153 154 A := 4.0; 155 C := F1'(B / 0.5) / A; 156 157 if C /= Ident_Fix(0.75) then 158 Failed ("Incorrect results for division (6) - result is " & 159 F3'Image(C)); 160 end if; 161 162 Result; 163 164end C455001; 165