* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@221916 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8b9fbe5..d93e5ac 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 0027d6f..d908a1b 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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)

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 7379477..6ffee06 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 74a39ec..a6a7be3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gnat.dg/opt48.adb b/gcc/testsuite/gnat.dg/opt48.adb
new file mode 100644 (file)
index 0000000..3f611cd
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt48.adb
@@ -0,0 +1,12 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/opt48_pkg1.adb b/gcc/testsuite/gnat.dg/opt48_pkg1.adb
new file mode 100644 (file)
index 0000000..306551c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt48_pkg1.adb
@@ -0,0 +1,17 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/opt48_pkg1.ads b/gcc/testsuite/gnat.dg/opt48_pkg1.ads
new file mode 100644 (file)
index 0000000..50154c2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt48_pkg1.ads
@@ -0,0 +1,7 @@
+with Opt48_Pkg2; use Opt48_Pkg2;
+
+package Opt48_Pkg1 is
+
+   function Get_Z return Rec;
+
+end Opt48_Pkg1;

diff --git a/gcc/testsuite/gnat.dg/opt48_pkg2.adb b/gcc/testsuite/gnat.dg/opt48_pkg2.adb
new file mode 100644 (file)
index 0000000..41836e7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt48_pkg2.adb
@@ -0,0 +1,8 @@
+package body Opt48_Pkg2 is
+
+   function F return Rec is
+   begin
+      return (12, "Hello world!");
+   end F;
+
+end Opt48_Pkg2;

diff --git a/gcc/testsuite/gnat.dg/opt48_pkg2.ads b/gcc/testsuite/gnat.dg/opt48_pkg2.ads
new file mode 100644 (file)
index 0000000..d3edbea
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt48_pkg2.ads
@@ -0,0 +1,11 @@
+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;