[COMMITTED] ada: Don't reuse operator nodes in expansion

Message ID 20221107083928.150465-1-poulhies@adacore.com
State Committed
Headers
Series [COMMITTED] ada: Don't reuse operator nodes in expansion |

Commit Message

Marc Poulhiès Nov. 7, 2022, 8:39 a.m. UTC
  From: Piotr Trojanek <trojanek@adacore.com>

This patch removes handling of references to unset objects that relied
on Original_Node. This handling was only needed because of rewriting
that reused operator nodes, for example, when an array inequality like:

  A < B

was rewritten into:

  System.Compare_Array_Unsigned_8.Compare_Array_U8
    (A'Address, B'Address, A'Length, B'Length) < 0

by keeping the node for operator "<" and only substituting its operands.
It seems safer to simply create an new operator node when rewriting and
not rely on Original_Node afterwards.

Cleanup related to improved detection uninitialized objects.

gcc/ada/

	* checks.adb (Apply_Arithmetic_Overflow_Strict): Rewrite using a
	newly created operator node.
	* exp_ch4.adb (Expand_Array_Comparison): Likewise.
	* exp_ch6.adb (Add_Call_By_Copy_Code): Rewriting actual parameter
	using its own location and not the location of the subprogram
	call.
	* sem_warn.adb (Check_References): Looping with Original_Node is
	no longer needed.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/checks.adb   | 27 +++++++++++--------
 gcc/ada/exp_ch4.adb  | 63 ++++++++++++++++++++++++++++----------------
 gcc/ada/exp_ch6.adb  |  2 +-
 gcc/ada/sem_warn.adb | 25 ------------------
 4 files changed, 58 insertions(+), 59 deletions(-)
  

Patch

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 47412948b78..a91c1cd5568 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -999,21 +999,26 @@  package body Checks is
                   Determine_Range (N, VOK, Vlo, Vhi, Assume_Valid => True);
 
                   if VOK and then Tlo <= Vlo and then Vhi <= Thi then
-                     Rewrite (Left_Opnd (N),
-                       Make_Type_Conversion (Loc,
-                         Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
-                         Expression   => Relocate_Node (Left_Opnd (N))));
-
-                     Rewrite (Right_Opnd (N),
-                       Make_Type_Conversion (Loc,
-                        Subtype_Mark => New_Occurrence_Of (Target_Type, Loc),
-                        Expression   => Relocate_Node (Right_Opnd (N))));
-
                      --  Rewrite the conversion operand so that the original
                      --  node is retained, in order to avoid the warning for
                      --  redundant conversions in Resolve_Type_Conversion.
 
-                     Rewrite (N, Relocate_Node (N));
+                     declare
+                        Op : constant Node_Id := New_Op_Node (Nkind (N), Loc);
+                     begin
+                        Set_Left_Opnd (Op,
+                          Make_Type_Conversion (Loc,
+                            Subtype_Mark =>
+                              New_Occurrence_Of (Target_Type, Loc),
+                            Expression   => Relocate_Node (Left_Opnd (N))));
+                        Set_Right_Opnd (Op,
+                          Make_Type_Conversion (Loc,
+                            Subtype_Mark =>
+                              New_Occurrence_Of (Target_Type, Loc),
+                            Expression   => Relocate_Node (Right_Opnd (N))));
+
+                        Rewrite (N, Op);
+                     end;
 
                      Set_Etype (N, Target_Type);
 
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7a3a414ca0d..bbbcf4f6952 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -1424,33 +1424,52 @@  package body Exp_Ch4 is
             Remove_Side_Effects (Op1, Name_Req => True);
             Remove_Side_Effects (Op2, Name_Req => True);
 
-            Rewrite (Op1,
-              Make_Function_Call (Sloc (Op1),
-                Name => New_Occurrence_Of (RTE (Comp), Loc),
+            declare
+               Comp_Call : constant Node_Id :=
+                 Make_Function_Call (Loc,
+                   Name => New_Occurrence_Of (RTE (Comp), Loc),
 
-                Parameter_Associations => New_List (
-                  Make_Attribute_Reference (Loc,
-                    Prefix         => Relocate_Node (Op1),
-                    Attribute_Name => Name_Address),
+                   Parameter_Associations => New_List (
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => Relocate_Node (Op1),
+                       Attribute_Name => Name_Address),
 
-                  Make_Attribute_Reference (Loc,
-                    Prefix         => Relocate_Node (Op2),
-                    Attribute_Name => Name_Address),
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => Relocate_Node (Op2),
+                       Attribute_Name => Name_Address),
 
-                  Make_Attribute_Reference (Loc,
-                    Prefix         => Relocate_Node (Op1),
-                    Attribute_Name => Name_Length),
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => Relocate_Node (Op1),
+                       Attribute_Name => Name_Length),
 
-                  Make_Attribute_Reference (Loc,
-                    Prefix         => Relocate_Node (Op2),
-                    Attribute_Name => Name_Length))));
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => Relocate_Node (Op2),
+                       Attribute_Name => Name_Length)));
+
+               Zero : constant Node_Id :=
+                 Make_Integer_Literal (Loc,
+                   Intval => Uint_0);
 
-            Rewrite (Op2,
-              Make_Integer_Literal (Sloc (Op2),
-                Intval => Uint_0));
+               Comp_Op : Node_Id;
 
-            Analyze_And_Resolve (Op1, Standard_Integer);
-            Analyze_And_Resolve (Op2, Standard_Integer);
+            begin
+               case Nkind (N) is
+                  when N_Op_Lt =>
+                     Comp_Op := Make_Op_Lt (Loc, Comp_Call, Zero);
+                  when N_Op_Le =>
+                     Comp_Op := Make_Op_Le (Loc, Comp_Call, Zero);
+                  when N_Op_Gt =>
+                     Comp_Op := Make_Op_Gt (Loc, Comp_Call, Zero);
+                  when N_Op_Ge =>
+                     Comp_Op := Make_Op_Ge (Loc, Comp_Call, Zero);
+                  when others =>
+                     raise Program_Error;
+               end case;
+
+               Rewrite (N, Comp_Op);
+            end;
+
+            Analyze_And_Resolve (N, Standard_Boolean);
             return;
          end if;
       end if;
@@ -9819,7 +9838,7 @@  package body Exp_Ch4 is
          --  avoids anomalies when the replacement is done in an instance and
          --  is epsilon more efficient.
 
-         Set_Entity            (N, Standard_Entity (S_Op_Rem));
+         pragma Assert (Entity (N) = Standard_Op_Rem);
          Set_Etype             (N, Typ);
          Set_Do_Division_Check (N, DDC);
          Expand_N_Op_Rem (N);
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index cf64e82bc99..9380f3dab0f 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1806,7 +1806,7 @@  package body Exp_Ch6 is
                Expr := New_Occurrence_Of (Temp, Loc);
             end if;
 
-            Rewrite (Actual, New_Occurrence_Of (Temp, Loc));
+            Rewrite (Actual, New_Occurrence_Of (Temp, Sloc (Actual)));
             Analyze (Actual);
 
             --  If the actual is a conversion of a packed reference, it may
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 83b9b20b44e..4552d907bac 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1460,31 +1460,6 @@  package body Sem_Warn is
                  and then not Known_To_Have_Preelab_Init (Etype (E1))
                then
 
-                  --  For other than access type, go back to original node to
-                  --  deal with case where original unset reference has been
-                  --  rewritten during expansion.
-
-                  --  In some cases, the original node may be a type
-                  --  conversion, a qualification or an attribute reference and
-                  --  in this case we want the object entity inside. Same for
-                  --  an expression with actions.
-
-                  UR := Original_Node (UR);
-                  loop
-                     if Nkind (UR) in N_Expression_With_Actions
-                                    | N_Qualified_Expression
-                                    | N_Type_Conversion
-                     then
-                        UR := Expression (UR);
-
-                     elsif Nkind (UR) = N_Attribute_Reference then
-                        UR := Prefix (UR);
-
-                     else
-                        exit;
-                     end if;
-                  end loop;
-
                   --  Don't issue warning if appearing inside Initial_Condition
                   --  pragma or aspect, since that expression is not evaluated
                   --  at the point where it occurs in the source.