diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 049f127608c..01f8c956c75 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,6 +1,15 @@ 2017-12-15 Jakub Jelinek Backported from mainline + 2017-11-23 Jakub Jelinek + + PR middle-end/82253 + * expr.c (expand_assignment): For CONCAT to_rtx, complex type from and + bitpos/bitsize covering the whole destination, use store_expr only if + the complex mode is the same. Otherwise, use expand_normal and if + it returns CONCAT, subreg each part separately instead of trying to + subreg the whole result. + 2017-11-22 Jakub Jelinek PR debug/83084 diff --git a/gcc/expr.c b/gcc/expr.c index 5221814aeaa..62b04bb4fae 100644 --- a/gcc/expr.c +++ b/gcc/expr.c @@ -5104,7 +5104,8 @@ expand_assignment (tree to, tree from, bool nontemporal) else if (GET_CODE (to_rtx) == CONCAT) { unsigned short mode_bitsize = GET_MODE_BITSIZE (GET_MODE (to_rtx)); - if (COMPLEX_MODE_P (TYPE_MODE (TREE_TYPE (from))) + if (TYPE_MODE (TREE_TYPE (from)) == GET_MODE (to_rtx) + && COMPLEX_MODE_P (GET_MODE (to_rtx)) && bitpos == 0 && bitsize == mode_bitsize) result = store_expr (from, to_rtx, false, nontemporal, reversep); @@ -5125,14 +5126,30 @@ expand_assignment (tree to, tree from, bool nontemporal) nontemporal, reversep); else if (bitpos == 0 && bitsize == mode_bitsize) { - rtx from_rtx; result = expand_normal (from); - from_rtx = simplify_gen_subreg (GET_MODE (to_rtx), result, - TYPE_MODE (TREE_TYPE (from)), 0); - emit_move_insn (XEXP (to_rtx, 0), - read_complex_part (from_rtx, false)); - emit_move_insn (XEXP (to_rtx, 1), - read_complex_part (from_rtx, true)); + if (GET_CODE (result) == CONCAT) + { + machine_mode to_mode = GET_MODE_INNER (GET_MODE (to_rtx)); + machine_mode from_mode = GET_MODE_INNER (GET_MODE (result)); + rtx from_real + = simplify_gen_subreg (to_mode, XEXP (result, 0), + from_mode, 0); + rtx from_imag + = simplify_gen_subreg (to_mode, XEXP (result, 1), + from_mode, 1); + emit_move_insn (XEXP (to_rtx, 0), from_real); + emit_move_insn (XEXP (to_rtx, 1), from_imag); + } + else + { + rtx from_rtx + = simplify_gen_subreg (GET_MODE (to_rtx), result, + TYPE_MODE (TREE_TYPE (from)), 0); + emit_move_insn (XEXP (to_rtx, 0), + read_complex_part (from_rtx, false)); + emit_move_insn (XEXP (to_rtx, 1), + read_complex_part (from_rtx, true)); + } } else { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index db3040d6e08..6afef5b83f3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,11 @@ 2017-12-15 Jakub Jelinek Backported from mainline + 2017-11-23 Jakub Jelinek + + PR middle-end/82253 + * gfortran.dg/pr82253.f90: New test. + 2017-11-22 Jakub Jelinek PR debug/83084 diff --git a/gcc/testsuite/gfortran.dg/pr82253.f90 b/gcc/testsuite/gfortran.dg/pr82253.f90 new file mode 100644 index 00000000000..4dc681012a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr82253.f90 @@ -0,0 +1,40 @@ +! PR middle-end/82253 +! { dg-do compile { target fortran_real_16 } } +! { dg-options "-Og" } + +module pr82253 + implicit none + private + public :: static_type + type, public :: T + procedure(), nopass, pointer :: testProc => null() + end type + type, public :: S + complex(kind=16), pointer :: ptr + end type + type(T), target :: type_complex32 + interface static_type + module procedure foo + end interface + interface + subroutine bar (testProc) + procedure(), optional :: testProc + end subroutine + end interface + contains + function foo (self) result(res) + complex(kind=16) :: self + type(T), pointer :: res + call bar (testProc = baz) + end function + subroutine baz (buffer, status) + character(len=*) :: buffer + integer(kind=4) :: status + complex(kind=16), target :: obj + type(S) :: self + integer(kind=1), parameter :: zero(storage_size(obj)/8) = 0 + obj = transfer (zero, obj) + self%ptr => obj + write (buffer, *, iostat=status) self%ptr, '#' + end subroutine +end module pr82253