exp_ch4.adb (Expand_N_Op_Eq): Introduce 'Machine for 'Result comparison.

2015-05-22  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Op_Eq): Introduce 'Machine for 'Result
	comparison.

From-SVN: r223559

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9c8ddbf..7105a7a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-22  Robert Dewar  <dewar@adacore.com>
+
+       * exp_ch4.adb (Expand_N_Op_Eq): Introduce 'Machine for 'Result
+       comparison.
+
 2015-05-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * sprint.adb (Source_Dump): When generating debug files, deal

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9f3be7e..df73482 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7519,7 +7519,31 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Special optimization of length comparison
+
       Optimize_Length_Comparison (N);
+
+      --  One more special case, if we have a comparison of X'Result = expr
+      --  in floating-point, then if not already there, change expr to be
+      --  f'Machine (expr) to eliminate suprise from extra precision.
+
+      if Is_Floating_Point_Type (Typl)
+        and then Nkind (Original_Node (Lhs)) = N_Attribute_Reference
+        and then Attribute_Name (Original_Node (Lhs)) = Name_Result
+      then
+         --  Stick in the Typ'Machine call if not already there
+
+         if Nkind (Rhs) /= N_Attribute_Reference
+           or else Attribute_Name (Rhs) /= Name_Machine
+         then
+            Rewrite (Rhs,
+              Make_Attribute_Reference (Loc,
+                Prefix         => New_Occurrence_Of (Typl, Loc),
+                Attribute_Name => Name_Machine,
+                Expressions    => New_List (Relocate_Node (Rhs))));
+            Analyze_And_Resolve (Rhs, Typl);
+         end if;
+      end if;
    end Expand_N_Op_Eq;
 
    -----------------------