utils2.c (find_common_type): Do not return the LHS type if it's an array with non...

	* gcc-interface/utils2.c (find_common_type): Do not return the LHS type
	if it's an array with non-constant lower bound and the RHS type is an
	array with a constant one.

From-SVN: r240913

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1e6f0a38553c0499bd5d9e369bc816b57df9c264..3965dcae747d8cf94083ba55d1f1b5a0110ad2fc 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,7 +1,13 @@
 2016-10-10  Eric Botcazou  <ebotcazou@adacore.com>
 
-       * gcc-interface/utils.c (convert): For a biased input type, convert
-       the bias itself to the base type before adding it.
+       * gcc-interface/utils2.c (find_common_type): Do not return the LHS type
+       if it's an array with non-constant lower bound and the RHS type is an
+       array with a constant one.
+
+2016-10-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/utils.c (convert): For a biased input type, convert the
+       bias itself to the base type before adding it.
 
 2016-10-08  Eric Botcazou  <ebotcazou@adacore.com>
 

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 1e5b3ef6611045211cdaefef19491a004097e041..b820fea28b75d752b389d3f771382c3da763ee91 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -215,27 +215,40 @@ find_common_type (tree t1, tree t2)
      calling into build_binary_op), some others are really expected and we
      have to be careful.  */
 
+  const bool variable_record_on_lhs
+    = (TREE_CODE (t1) == RECORD_TYPE
+       && TREE_CODE (t2) == RECORD_TYPE
+       && get_variant_part (t1)
+       && !get_variant_part (t2));
+
+  const bool variable_array_on_lhs
+    = (TREE_CODE (t1) == ARRAY_TYPE
+       && TREE_CODE (t2) == ARRAY_TYPE
+       && !TREE_CONSTANT (TYPE_MIN_VALUE (TYPE_DOMAIN (t1)))
+       && TREE_CONSTANT (TYPE_MIN_VALUE (TYPE_DOMAIN (t2))));
+
   /* We must avoid writing more than what the target can hold if this is for
      an assignment and the case of tagged types is handled in build_binary_op
      so we use the lhs type if it is known to be smaller or of constant size
      and the rhs type is not, whatever the modes.  We also force t1 in case of
      constant size equality to minimize occurrences of view conversions on the
-     lhs of an assignment, except for the case of record types with a variant
-     part on the lhs but not on the rhs to make the conversion simpler.  */
+     lhs of an assignment, except for the case of types with a variable part
+     on the lhs but not on the rhs to make the conversion simpler.  */
   if (TREE_CONSTANT (TYPE_SIZE (t1))
       && (!TREE_CONSTANT (TYPE_SIZE (t2))
          || tree_int_cst_lt (TYPE_SIZE (t1), TYPE_SIZE (t2))
          || (TYPE_SIZE (t1) == TYPE_SIZE (t2)
-             && !(TREE_CODE (t1) == RECORD_TYPE
-                  && TREE_CODE (t2) == RECORD_TYPE
-                  && get_variant_part (t1)
-                  && !get_variant_part (t2)))))
+             && !variable_record_on_lhs
+             && !variable_array_on_lhs)))
     return t1;
 
-  /* Otherwise, if the lhs type is non-BLKmode, use it.  Note that we know
-     that we will not have any alignment problems since, if we did, the
-     non-BLKmode type could not have been used.  */
-  if (TYPE_MODE (t1) != BLKmode)
+  /* Otherwise, if the lhs type is non-BLKmode, use it, except for the case of
+     a non-BLKmode rhs and array types with a variable part on the lhs but not
+     on the rhs to make sure the conversion is preserved during gimplification.
+     Note that we know that we will not have any alignment problems since, if
+     we did, the non-BLKmode type could not have been used.  */
+  if (TYPE_MODE (t1) != BLKmode
+      && (TYPE_MODE (t2) == BLKmode || !variable_array_on_lhs))
     return t1;
 
   /* If the rhs type is of constant size, use it whatever the modes.  At

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1d07fcdb062a502f4b04e1419bbd4276ea0fcb28..bf766822198d09f6a4a9b802f36f10a6f91d9162 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-10  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/inline13.ad[sb]: New test.
+       * gnat.dg/inline13_pkg.ad[sb]: New helper.
+
 2016-10-10  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/biased_subtype.adb: New test.

diff --git a/gcc/testsuite/gnat.dg/inline13.adb b/gcc/testsuite/gnat.dg/inline13.adb
new file mode 100644 (file)
index 0000000..4be6514
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline13.adb
@@ -0,0 +1,19 @@
+-- { dg-do compile }
+-- { dg-options "-O -gnatn" }
+
+package body Inline13 is
+
+  function F (L : Arr) return String is
+    Local : Arr (1 .. L'Length);
+    Ret : String (1 .. L'Length);
+    Pos : Natural := 1;
+  begin
+    Local (1 .. L'Length) := L;
+    for I in 1 .. Integer (L'Length) loop
+       Ret (Pos .. Pos + 8) := " " & Inline13_Pkg.Padded (Local (I));
+       Pos := Pos + 9;
+    end loop;
+    return Ret;
+  end;
+
+end Inline13;

diff --git a/gcc/testsuite/gnat.dg/inline13.ads b/gcc/testsuite/gnat.dg/inline13.ads
new file mode 100644 (file)
index 0000000..7e8f8d6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline13.ads
@@ -0,0 +1,9 @@
+with Inline13_Pkg;
+
+package Inline13 is
+
+  type Arr is array (Positive range <>) of Inline13_Pkg.T;
+
+  function F (L : Arr) return String;
+
+end Inline13;

diff --git a/gcc/testsuite/gnat.dg/inline13_pkg.adb b/gcc/testsuite/gnat.dg/inline13_pkg.adb
new file mode 100644 (file)
index 0000000..61c0f05
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline13_pkg.adb
@@ -0,0 +1,8 @@
+package body Inline13_Pkg is
+
+  function Padded (Value : T) return Padded_T is
+  begin
+    return Padded_T(Value);
+  end Padded;
+
+end Inline13_Pkg;

diff --git a/gcc/testsuite/gnat.dg/inline13_pkg.ads b/gcc/testsuite/gnat.dg/inline13_pkg.ads
new file mode 100644 (file)
index 0000000..814cf80
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/inline13_pkg.ads
@@ -0,0 +1,10 @@
+package Inline13_Pkg is
+
+  subtype Padded_T is String (1..8);
+
+  type T is new Padded_T;
+
+  function Padded (Value : T) return Padded_T;
+  pragma Inline_Always (Padded);
+
+end Inline13_Pkg;