[PATCH] Fix wrong code out of NRV + RSO + inlining

[Eric Botcazou]

Hi,

the attached Ada testcase compiled with -O -flto exhibits a wrong code issue 
when the 3 optimizations NRV + RSO + inlining are applied to the same call: if 
the LHS of the call is marked write-only before inlining, then it will keep 
the mark after inlining although it may be read in GIMPLE from that point on.

The proposed fix is to always clear the flag during inlining in the RSO case.
Tested on x86-64/Linux, OK for the mainline?


2024-09-11  Eric Botcazou  <ebotca...@adacore.com>

        * tree-inline.cc (declare_return_variable): Clear writeonly flag on
        a global variable used directly as the return slot.

2024-09-11  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/lto27.adb: New test.
        * gnat.dg/lto27_pkg1.ads, gnat.dg/lto27_pkg2.ads,
        gnat.dg/lto27_pkg2.adb, gnat.dg/lto27_pkg3.ads: New helper.


-- 
Eric Botcazou
diff --git a/gcc/tree-inline.cc b/gcc/tree-inline.cc
index f31a34ac410..2bb1e1602b2 100644
--- a/gcc/tree-inline.cc
+++ b/gcc/tree-inline.cc
@@ -3782,6 +3782,11 @@ declare_return_variable (copy_body_data *id, tree return_slot, tree modify_dest,
 	  gcc_assert (TREE_CODE (var) != SSA_NAME);
 	  if (TREE_ADDRESSABLE (result))
 	    mark_addressable (var);
+	  /* RESULT may also be read in the callee, typically because the NRV
+	     optimization has been applied to the function, so VAR may also be
+	     read from now on.  */
+	  if (VAR_P (var) && (TREE_STATIC (var) || DECL_EXTERNAL (var)))
+	    varpool_node::get (var)->writeonly = 0;
 	}
       if (DECL_NOT_GIMPLE_REG_P (result)
 	  && DECL_P (var))

-- { dg-do run }
-- { dg-options "-O -flto" { target lto } }

with Lto27_Pkg1;

procedure Lto27 is
begin
   null;
end;

with Lto27_Pkg2;

package Lto27_Pkg1 is
   package I is new Lto27_Pkg2.G;
end Lto27_Pkg1;

package body Lto27_Pkg2 is

   function F return Lto27_Pkg3.Q_Rec is
   begin
      return Result : Lto27_Pkg3.Q_Rec := Lto27_Pkg3.Default_Q_Rec do
         Result.A := 1.0;
      end return;
   end;

end Lto27_Pkg2;

with Lto27_Pkg3;

package Lto27_Pkg2 is

   function F return Lto27_Pkg3.Q_Rec;

   generic
      Q_Conf : Lto27_Pkg3.Q_Rec := F;
   package G is end;

end Lto27_Pkg2;

package Lto27_Pkg3 is

   type Discr_Type is (P, Q);

   type Rec (Discr : Discr_Type) is record
      case Discr is
         when Q =>
            A : Duration := 0.0;
            B : Duration := 0.0;
         when P =>
            null;
      end case;
   end record;

   subtype Q_Rec is Rec (Q);

   Default_Q_Rec : constant Q_Rec := (Discr => Q, others => <>);

end Lto27_Pkg3;