1separate (T_Expressions) 2procedure Test_Real_Equality is 3 4 type A is digits 10 range -1.0 .. 1.0; 5 type B is digits 10; 6 subtype SB is B range -2.0 .. 10.0; 7 8 type C is delta 0.125 range -1.0 .. 1.0; 9 type D is delta 0.1 digits 15; 10 subtype SD is D digits 10; 11 12 VA1, VA2 : A := 0.0; 13 VB1, VB2 : B := 0.0; 14 VSB1, VSB2 : SB := 0.0; 15 VC1, VC2 : C := 0.0; 16 VD1, VD2 : D := 0.0; 17 VSD1, VSD2 : SD := 0.0; 18 VFloat : Float := 0.0; 19 20 function X return A is 21 begin 22 return A (0.0); -- type_conversion 23 end X; 24 25 function X return SB is 26 begin 27 return SB (0.0); -- type_conversion 28 end X; 29 30 function X return C is 31 begin 32 return C (0.0); -- type_conversion 33 end X; 34 35 function X return Float is 36 begin 37 return Float (0.0); -- type_conversion 38 end X; 39 40 -- Renaming of "=" 41 function Equal (L, R : A) return Boolean renames "="; 42 43 -- Redefinition of "=" 44 type E is new Float; 45 function "=" (A, B : E) return Boolean is 46 begin 47 return abs (A - B) < 0.01; -- Unparenthesized 48 end "="; 49 50 VE1, VE2 : E; 51 52 type DE is new E; 53 VDE1, VDE2 : DE; 54 55begin 56 57 if VA1 = VA2 then -- real_equality 58 null; 59 elsif VB1 /= 0.0 then -- real_equality 60 null; 61 elsif 1.0 /= VB1 then -- real_equality 62 null; 63 elsif VB1 /= X then -- real_equality, function_call 64 null; 65 elsif VSB1 = VSB2 then -- real_equality 66 null; 67 elsif VSB1 = X then -- real_equality, function_call 68 null; 69 elsif VC1 /= 0.0 then -- real_equality 70 null; 71 elsif 1.0 /= VC1 then -- real_equality 72 null; 73 elsif VC1 /= C (0.0) then -- real_equality, type_conversion 74 null; 75 elsif VC1 = X then -- real_equality, function_call 76 null; 77 elsif VD1 = VD2 then -- real_equality 78 null; 79 elsif VSD1 /= 0.0 then -- real_equality 80 null; 81 elsif 1.0 /= VSD1 then -- real_equality 82 null; 83 elsif VSD1 /= SD (0.0) then -- real_equality, type_conversion 84 null; 85 elsif VFloat /= X then -- real_equality, function_call 86 null; 87 elsif 0.0 = 1.0 then -- real_equality 88 null; 89 end if; 90 91 if Equal (VA1, VA2) then -- real_equality, function_call 92 null; 93 end if; 94 95 if VE1 = 1.0 then -- function_call 96 null; 97 elsif VE1 = VE2 then -- function_call 98 null; 99 elsif VE2 /= 0.0 then -- function_call 100 null; 101 elsif VE2 /= VE1 then -- function_call 102 null; 103 end if; 104 105 if VDE1 = 1.0 then -- Inherited_Function_Call, Function_Call 106 null; 107 elsif VDE1 = VDE2 then -- Inherited_Function_Call, Function_Call 108 null; 109 elsif VDE2 /= 0.0 then -- Function_Call 110 null; 111 elsif VDE2 /= VDE1 then -- Function_Call 112 null; 113 end if; 114 115end Test_Real_Equality; 116