From: Vasiliy Fofanov <fofanov@adacore.com>
Date: Fri, 22 May 2020 11:22:41 +0000 (+0200)
Subject: [Ada] Optional warning on build-in-place function calls
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b19c922bf471e4202bf4853cab9575d4a924657c;p=gcc.git

[Ada] Optional warning on build-in-place function calls

gcc/ada/

	* debug.adb: Document new switch.
	* exp_ch6.adb (Warn_BIP): New function that warns if the switch
	is on.  Call it from Make_Build_In_Place_* functions.  Warn_BIP
	is not needed in Make_Build_In_Place_Iface_*, because those call
	Make_Build_In_Place_Call_In_Object_Declaration or similar.
---

diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 0f73c2a17ae..316a798e584 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -173,7 +173,7 @@ package body Debug is
    --  d_z  Enable Put_Image on tagged types
 
    --  d_A  Stop generation of ALI file
-   --  d_B
+   --  d_B  Warn on build-in-place function calls
    --  d_C
    --  d_D
    --  d_E
@@ -1003,6 +1003,10 @@ package body Debug is
 
    --  d_A  Do not generate ALI files by setting Opt.Disable_ALI_File.
 
+   --  d_B  Warn on build-in-place function calls. This allows users to
+   --       inspect their code in case it triggers compiler bugs related
+   --       to build-in-place calls. See known-problem entries for details.
+
    --  d_F  The compiler encodes the full path from an invocation construct to
    --       an external target, offering additional information to GNATBIND for
    --       purposes of error diagnostics.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index c882630fd1c..e3fcbc7afef 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -306,6 +306,10 @@ package body Exp_Ch6 is
    --  out of. This ensures that the secondary stack is not released; otherwise
    --  the function result would be reclaimed before returning to the caller.
 
+   procedure Warn_BIP (Func_Call : Node_Id);
+   --  Give a warning on a build-in-place function call if the -gnatd_B switch
+   --  was given.
+
    ----------------------------------------------
    -- Add_Access_Actual_To_Build_In_Place_Call --
    ----------------------------------------------
@@ -8739,6 +8743,8 @@ package body Exp_Ch6 is
          raise Program_Error;
       end if;
 
+      Warn_BIP (Func_Call);
+
       Result_Subt := Available_View (Etype (Function_Id));
 
       --  Create a temp for the function result. In the caller-allocates case,
@@ -8995,6 +9001,8 @@ package body Exp_Ch6 is
          raise Program_Error;
       end if;
 
+      Warn_BIP (Func_Call);
+
       Result_Subt := Etype (Function_Id);
 
       --  If the build-in-place function returns a controlled object, then the
@@ -9142,6 +9150,8 @@ package body Exp_Ch6 is
          raise Program_Error;
       end if;
 
+      Warn_BIP (Func_Call);
+
       Result_Subt := Etype (Func_Id);
 
       --  When the result subtype is unconstrained, an additional actual must
@@ -9286,6 +9296,8 @@ package body Exp_Ch6 is
 
       Set_Is_Expanded_Build_In_Place_Call (Func_Call);
 
+      Warn_BIP (Func_Call);
+
       --  Create an access type designating the function's result subtype.
       --  We use the type of the original call because it may be a call to an
       --  inherited operation, which the expansion has replaced with the parent
@@ -10330,4 +10342,15 @@ package body Exp_Ch6 is
       return Unqual_BIP_Function_Call (Expr);
    end Unqual_BIP_Iface_Function_Call;
 
+   --------------
+   -- Warn_BIP --
+   --------------
+
+   procedure Warn_BIP (Func_Call : Node_Id) is
+   begin
+      if Debug_Flag_Underscore_BB then
+         Error_Msg_N ("build-in-place function call?", Func_Call);
+      end if;
+   end Warn_BIP;
+
 end Exp_Ch6;