decl.c (gnat_to_gnu_entity): Do not make a function returning an unconstrained…

decl.c (gnat_to_gnu_entity): Do not make a function returning an unconstrained type 'const' for the middle-end.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Do not make
	a function returning an unconstrained type 'const' for the middle-end.

	* gcc-interface/trans.c (Pragma_to_gnu) <case Pragma_Warning>: Use
	exact condition to detect Reason => "..." pattern.

From-SVN: r221916

gcc/ada/ChangeLog

+2015-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Function>: Do not make
+	a function returning an unconstrained type 'const' for the middle-end.
+
+	* gcc-interface/trans.c (Pragma_to_gnu) <case Pragma_Warning>: Use
+	exact condition to detect Reason => "..." pattern.
+
 2015-03-31  Tom de Vries  <tom@codesourcery.com>
 
 	PR ada/65490

gcc/ada/gcc-interface/decl.c

@@ -4266,8 +4266,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		return_by_direct_ref_p = true;
 	      }
 
-	    /* If we are supposed to return an unconstrained array type, make
-	       the actual return type the fat pointer type.  */
+	    /* If the return type is an unconstrained array type, the return
+	       value will be allocated on the secondary stack so the actual
+	       return type is the fat pointer type.  */
 	    else if (TREE_CODE (gnu_return_type) == UNCONSTRAINED_ARRAY_TYPE)
 	      {
 		gnu_return_type = TREE_TYPE (gnu_return_type);
@@ -4275,8 +4276,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      }
 
 	    /* Likewise, if the return type requires a transient scope, the
-	       return value will be allocated on the secondary stack so the
-	       actual return type is the pointer type.  */
+	       return value will also be allocated on the secondary stack so
+	       the actual return type is the pointer type.  */
 	    else if (Requires_Transient_Scope (gnat_return_type))
 	      {
 		gnu_return_type = build_pointer_type (gnu_return_type);
@@ -4591,11 +4592,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				 return_by_direct_ref_p,
 				 return_by_invisi_ref_p);
 
-	/* A subprogram (something that doesn't return anything) shouldn't
-	   be considered const since there would be no reason for such a
+	/* A procedure (something that doesn't return anything) shouldn't be
+	   considered const since there would be no reason for calling such a
 	   subprogram.  Note that procedures with Out (or In Out) parameters
-	   have already been converted into a function with a return type.  */
-	if (TREE_CODE (gnu_return_type) == VOID_TYPE)
+	   have already been converted into a function with a return type.
+	   Similarly, if the function returns an unconstrained type, then the
+	   function will allocate the return value on the secondary stack and
+	   thus calls to it cannot be CSE'ed, lest the stack be reclaimed.  */
+	if (TREE_CODE (gnu_return_type) == VOID_TYPE || return_unconstrained_p)
 	  const_flag = false;
 
 	if (const_flag || volatile_flag)

gcc/ada/gcc-interface/trans.c

@@ -1444,7 +1444,8 @@ Pragma_to_gnu (Node_Id gnat_node)
 	      }
 
 	    /* Deal with optional pattern (but ignore Reason => "...").  */
-	    if (Present (Next (gnat_temp)) && No (Chars (Next (gnat_temp))))
+	    if (Present (Next (gnat_temp))
+		&& Chars (Next (gnat_temp)) != Name_Reason)
 	      {
 		/* pragma Warnings (On | Off, Name) is handled differently.  */
 		if (Nkind (Expression (Next (gnat_temp))) != N_String_Literal)

gcc/testsuite/ChangeLog

+2015-04-08  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/opt48.adb: New test.
+	* gnat.dg/opt48_pkg1.ad[sb]: New helper.
+	* gnat.dg/opt48_pkg2.ad[sb]: Likewise.
+
 2015-04-07  Jan Hubicka  <hubicka@ucw.cz>
 
 	PR ipa/65540

gcc/testsuite/gnat.dg/opt48.adb

+-- { dg-do run }
+-- { dg-options "-O" }
+
+with Opt48_Pkg1; use Opt48_Pkg1;
+with Opt48_Pkg2; use Opt48_Pkg2;
+
+procedure Opt48 is
+begin
+   if Get_Z /= (12, "Hello world!") then
+      raise Program_Error;
+   end if;
+end;

gcc/testsuite/gnat.dg/opt48_pkg1.adb

+package body Opt48_Pkg1 is
+
+   function G return Rec is
+   begin
+      return (32, "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA");
+   end G;
+
+   X : Rec := F;
+   Y : Rec := G;
+   Z : Rec := F;
+
+   function Get_Z return Rec is
+   begin
+      return Z;
+   end;
+
+end Opt48_Pkg1;

gcc/testsuite/gnat.dg/opt48_pkg1.ads

+with Opt48_Pkg2; use Opt48_Pkg2;
+
+package Opt48_Pkg1 is
+
+   function Get_Z return Rec;
+
+end Opt48_Pkg1;

gcc/testsuite/gnat.dg/opt48_pkg2.adb

+package body Opt48_Pkg2 is
+
+   function F return Rec is
+   begin
+      return (12, "Hello world!");
+   end F;
+
+end Opt48_Pkg2;

gcc/testsuite/gnat.dg/opt48_pkg2.ads

+package Opt48_Pkg2 is
+
+   pragma Pure;
+
+   type Rec (L : Natural) is record
+      S : String (1 .. L);
+   end record;
+
+   function F return Rec;
+
+end Opt48_Pkg2;