trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for a call to a function that returns...

	* gcc-interface/trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for
	a call to a function that returns an unconstrained type with default
	discriminant.  Similarly, avoid doing the conversion to the nominal

From-SVN: r183610

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 433fff461d8c01e9edff48c181625559ad56f9c2..2b9db093cabf5efcc1310ce9eda0e9fd3af314aa 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (gnat_to_gnu): Avoid making a SAVE_EXPR for
+       a call to a function that returns an unconstrained type with default
+       discriminant.  Similarly, avoid doing the conversion to the nominal
+       result type in this case.
+
 2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/ada-tree.h (DECL_ALIASED_P): New flag.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 077d4a64769b16cb1a0e2d2de0894d25848cd3f3..53a277e368f0b35e035fc60f03cc8b2240368fcb 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -6869,10 +6869,14 @@ gnat_to_gnu (Node_Id gnat_node)
                                    N_Raise_Constraint_Error));
     }
 
-  /* If our result has side-effects and is of an unconstrained type,
-     make a SAVE_EXPR so that we can be sure it will only be referenced
-     once.  Note we must do this before any conversions.  */
+  /* If the result has side-effects and is of an unconstrained type, make a
+     SAVE_EXPR so that we can be sure it will only be referenced once.  But
+     this is useless for a call to a function that returns an unconstrained
+     type with default discriminant, as we cannot compute the size of the
+     actual returned object.  We must do this before any conversions.  */
   if (TREE_SIDE_EFFECTS (gnu_result)
+      && !(TREE_CODE (gnu_result) == CALL_EXPR
+          && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result)))
       && (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
          || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
     gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
@@ -6898,7 +6902,11 @@ gnat_to_gnu (Node_Id gnat_node)
        3. If the type is void or if we have no result, return error_mark_node
          to show we have no result.
 
-       4. Finally, if the type of the result is already correct.  */
+       4. If this a call to a function that returns an unconstrained type with
+         default discriminant, return the call expression unmodified since we
+         cannot compute the size of the actual returned object.
+
+       5. Finally, if the type of the result is already correct.  */
 
   if (Present (Parent (gnat_node))
       && (lhs_or_actual_p (gnat_node)
@@ -6949,7 +6957,19 @@ gnat_to_gnu (Node_Id gnat_node)
   else if (gnu_result == error_mark_node || gnu_result_type == void_type_node)
     gnu_result = error_mark_node;
 
-  else if (gnu_result_type != TREE_TYPE (gnu_result))
+  else if (TREE_CODE (gnu_result) == CALL_EXPR
+          && TYPE_IS_PADDING_P (TREE_TYPE (gnu_result))
+          && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type)))
+    {
+      /* ??? We need to convert if the padded type has fixed size because
+        gnat_types_compatible_p will say that padded types are compatible
+        but the gimplifier will not and, therefore, will ultimately choke
+        if there isn't a conversion added early.  */
+      if (TREE_CODE (TYPE_SIZE (TREE_TYPE (gnu_result))) == INTEGER_CST)
+       gnu_result = convert (gnu_result_type, gnu_result);
+    }
+
+  else if (TREE_TYPE (gnu_result) != gnu_result_type)
     gnu_result = convert (gnu_result_type, gnu_result);
 
   /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on the result.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 66a5eedf1845401e59e3cf87fc7c0c6ad20d9d49..a1844b7cf9033383786ac17401e1ff0f60b24dc0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/discr34.adb: New test.
+       * gnat.dg/discr34_pkg.ads: New helper.
+
 2012-01-27  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/discr33.adb: New test.

diff --git a/gcc/testsuite/gnat.dg/discr34.adb b/gcc/testsuite/gnat.dg/discr34.adb
new file mode 100644 (file)
index 0000000..7beab95
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr34.adb
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+
+with Discr34_Pkg; use Discr34_Pkg;
+
+procedure Discr34 is
+   Object : Rec := F;
+begin
+   null;
+end;

diff --git a/gcc/testsuite/gnat.dg/discr34_pkg.ads b/gcc/testsuite/gnat.dg/discr34_pkg.ads
new file mode 100644 (file)
index 0000000..9a3380e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr34_pkg.ads
@@ -0,0 +1,16 @@
+package Discr34_Pkg is
+
+   function N return Natural;
+
+   type Enum is (One, Two);
+
+   type Rec (D : Enum := One) is record
+      case D is
+        when One => S : String (1 .. N);
+        when Two => null;
+      end case;
+   end record;
+
+   function F return Rec;
+
+end Discr34_Pkg;