expr.c (store_field): In the bitfield case...

* expr.c (store_field): In the bitfield case, if the value comes from
	a function call and is of an aggregate type returned in registers, do
	not modify the field mode; extract the value in all cases if the mode
	is BLKmode and the size is not larger than a word.

From-SVN: r244249

gcc/ChangeLog

@@ -1,3 +1,10 @@
+2017-01-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* expr.c (store_field): In the bitfield case, if the value comes from
+	a function call and is of an aggregate type returned in registers, do
+	not modify the field mode; extract the value in all cases if the mode
+	is BLKmode and the size is not larger than a word.
+
 2017-01-09  Dominique d'Humieres  <dominiq@lps.ens.fr>
 
 	PR target/71017

gcc/expr.c

@@ -6888,33 +6888,30 @@ store_field (rtx target, HOST_WIDE_INT bitsize, HOST_WIDE_INT bitpos,
       if (GET_CODE (temp) == PARALLEL)
 	{
 	  HOST_WIDE_INT size = int_size_in_bytes (TREE_TYPE (exp));
-	  rtx temp_target;
-	  if (mode == BLKmode || mode == VOIDmode)
-	    mode = smallest_mode_for_size (size * BITS_PER_UNIT, MODE_INT);
-	  temp_target = gen_reg_rtx (mode);
+	  machine_mode temp_mode
+	    = smallest_mode_for_size (size * BITS_PER_UNIT, MODE_INT);
+	  rtx temp_target = gen_reg_rtx (temp_mode);
 	  emit_group_store (temp_target, temp, TREE_TYPE (exp), size);
 	  temp = temp_target;
 	}
-      else if (mode == BLKmode)
+
+      /* Handle calls that return BLKmode values in registers.  */
+      else if (mode == BLKmode && REG_P (temp) && TREE_CODE (exp) == CALL_EXPR)
 	{
-	  /* Handle calls that return BLKmode values in registers.  */
-	  if (REG_P (temp) && TREE_CODE (exp) == CALL_EXPR)
-	    {
-	      rtx temp_target = gen_reg_rtx (GET_MODE (temp));
-	      copy_blkmode_from_reg (temp_target, temp, TREE_TYPE (exp));
-	      temp = temp_target;
-	    }
-	  else
-	    {
-	      HOST_WIDE_INT size = int_size_in_bytes (TREE_TYPE (exp));
-	      rtx temp_target;
-	      mode = smallest_mode_for_size (size * BITS_PER_UNIT, MODE_INT);
-	      temp_target = gen_reg_rtx (mode);
-	      temp_target
-	        = extract_bit_field (temp, size * BITS_PER_UNIT, 0, 1,
-				     temp_target, mode, mode, false);
-	      temp = temp_target;
-	    }
+	  rtx temp_target = gen_reg_rtx (GET_MODE (temp));
+	  copy_blkmode_from_reg (temp_target, temp, TREE_TYPE (exp));
+	  temp = temp_target;
+	}
+
+      /* The behavior of store_bit_field is awkward when mode is BLKmode:
+	 it always takes its value from the lsb up to the word size but
+	 expects it left justified beyond it.  At this point TEMP is left
+	 justified so extract the value in the former case.  */
+      if (mode == BLKmode && bitsize <= BITS_PER_WORD)
+	{
+	  machine_mode temp_mode = smallest_mode_for_size (bitsize, MODE_INT);
+	  temp = extract_bit_field (temp, bitsize, 0, 1, NULL_RTX, temp_mode,
+				    temp_mode, false);
 	}
 
       /* Store the value in the bitfield.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,14 @@
+2017-01-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* g++.dg/opt/call2.C: New test.
+	* g++.dg/opt/call3.C: Likewise.
+	* gnat.dg/array26.adb: New test.
+	* gnat.dg/array26_pkg.ad[sb]: New helper.
+	* gnat.dg/array27.adb: New test.
+	* gnat.dg/array27_pkg.ad[sb]: New helper.
+	* gnat.dg/array28.adb: New test.
+	* gnat.dg/array28_pkg.ad[sb]: New helper.
+
 2017-01-09  Jakub Jelinek  <jakub@redhat.com>
 
 	PR translation/79019

gcc/testsuite/g++.dg/opt/call2.C

@@ -0,0 +1,34 @@
+// { dg-do run }
+// { dg-options "-O" }
+
+struct Foo
+{
+  Foo() : a(1), b(1), c('a') {}
+  int a;
+  int b;
+  char c;
+};
+
+static Foo copy_foo(Foo) __attribute__((noinline, noclone));
+
+static Foo copy_foo(Foo A)
+{
+  return A;
+}
+
+struct Bar : Foo
+{
+  Bar(Foo t) : Foo(copy_foo(t)) {}
+};
+
+Foo F;
+
+int main (void)
+{
+  Bar B (F);
+
+  if (B.a != 1 || B.b != 1 || B.c != 'a')
+    __builtin_abort ();
+
+  return 0;
+}

gcc/testsuite/g++.dg/opt/call3.C

@@ -0,0 +1,33 @@
+// { dg-do run }
+// { dg-options "-O" }
+
+struct Foo
+{
+  Foo() : a(1), c('a') {}
+  short int a;
+  char c;
+};
+
+static Foo copy_foo(Foo) __attribute__((noinline, noclone));
+
+static Foo copy_foo(Foo A)
+{
+  return A;
+}
+
+struct Bar : Foo
+{
+  Bar(Foo t) : Foo(copy_foo(t)) {}
+};
+
+Foo F;
+
+int main (void)
+{
+  Bar B (F);
+
+  if (B.a != 1 || B.c != 'a')
+    __builtin_abort ();
+
+  return 0;
+}

gcc/testsuite/gnat.dg/array26.adb

@@ -0,0 +1,22 @@
+-- { dg-do run }
+-- { dg-options "-O" }
+
+with Array26_Pkg; use Array26_Pkg;
+
+procedure Array26 is
+
+  function Get return Outer_type is
+    Ret : Outer_Type;
+  begin
+    Ret (Inner_Type'Range) := F;
+    return Ret;
+  end;
+
+  A : Outer_Type := Get;
+  B : Inner_Type := A (Inner_Type'Range);
+
+begin
+  if B /= "123" then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/array26_pkg.adb

@@ -0,0 +1,8 @@
+package body Array26_Pkg is
+
+  function F return Inner_Type is
+  begin
+    return "123";
+  end;
+
+end Array26_Pkg;

gcc/testsuite/gnat.dg/array26_pkg.ads

@@ -0,0 +1,8 @@
+package Array26_Pkg is
+
+  subtype Outer_Type is String (1 .. 4);
+  subtype Inner_Type is String (1 .. 3);
+
+  function F return Inner_Type;
+
+end Array26_Pkg;

gcc/testsuite/gnat.dg/array27.adb

@@ -0,0 +1,22 @@
+-- { dg-do run }
+-- { dg-options "-O" }
+
+with Array27_Pkg; use Array27_Pkg;
+
+procedure Array27 is
+
+  function Get return Outer_type is
+    Ret : Outer_Type;
+  begin
+    Ret (Inner_Type'Range) := F;
+    return Ret;
+  end;
+
+  A : Outer_Type := Get;
+  B : Inner_Type := A (Inner_Type'Range);
+
+begin
+    if B /= "123" then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/array27_pkg.adb

@@ -0,0 +1,8 @@
+package body Array27_Pkg is
+
+  function F return Inner_Type is
+  begin
+    return "123";
+  end;
+
+end Array27_Pkg;

gcc/testsuite/gnat.dg/array27_pkg.ads

@@ -0,0 +1,8 @@
+package Array27_Pkg is
+
+  subtype Outer_Type is String (1 .. 8);
+  subtype Inner_Type is String (1 .. 3);
+
+  function F return Inner_Type;
+
+end Array27_Pkg;

gcc/testsuite/gnat.dg/array28.adb

@@ -0,0 +1,22 @@
+-- { dg-do run }
+-- { dg-options "-O" }
+
+with Array28_Pkg; use Array28_Pkg;
+
+procedure Array28 is
+
+  function Get return Outer_type is
+    Ret : Outer_Type;
+  begin
+    Ret (Inner_Type'Range) := F;
+    return Ret;
+  end;
+
+  A : Outer_Type := Get;
+  B : Inner_Type := A (Inner_Type'Range);
+
+begin
+  if B /= "12345" then
+    raise Program_Error;
+  end if;
+end;

gcc/testsuite/gnat.dg/array28_pkg.adb

@@ -0,0 +1,8 @@
+package body Array28_Pkg is
+
+  function F return Inner_Type is
+  begin
+    return "12345";
+  end;
+
+end Array28_Pkg;

gcc/testsuite/gnat.dg/array28_pkg.ads

@@ -0,0 +1,8 @@
+package Array28_Pkg is
+
+  subtype Outer_Type is String (1 .. 8);
+  subtype Inner_Type is String (1 .. 5);
+
+  function F return Inner_Type;
+
+end Array28_Pkg;