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