diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index b8c908b51e9..e8f780d1ef9 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -12404,6 +12404,11 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) { /* Assign the rhs to the temporary. */ tmp_expr = get_temp_from_expr ((*code)->expr1, ns); + if (tmp_expr->symtree->n.sym->attr.pointer) + { + tmp_expr->symtree->n.sym->attr.pointer = 0; + tmp_expr->symtree->n.sym->attr.allocatable = 1; + } this_code = build_assignment (EXEC_ASSIGN, tmp_expr, (*code)->expr2, NULL, NULL, (*code)->loc); diff --git a/gcc/testsuite/gfortran.dg/defined_assignment_12.f90 b/gcc/testsuite/gfortran.dg/defined_assignment_12.f90 new file mode 100644 index 00000000000..57445abe25c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/defined_assignment_12.f90 @@ -0,0 +1,61 @@ +! { dg-do run } +! +! Test fix of PR109066, which caused segfaults as below +! +! Contributed by Andrew Benson +! +module bugMod + + type :: rm + integer :: c=0 + contains + procedure :: rma + generic :: assignment(=) => rma + end type rm + + type :: lc + type(rm) :: lm + end type lc + +contains + + impure elemental subroutine rma(to,from) + implicit none + class(rm), intent(out) :: to + class(rm), intent(in) :: from + to%c = -from%c + return + end subroutine rma + +end module bugMod + +program bug + use bugMod + implicit none + type(lc), pointer :: i, j(:) + + allocate (i) + i = lc (rm (1)) ! Segmentation fault + if (i%lm%c .ne. -1) stop 1 + i = i_ptr () ! Segmentation fault + if (i%lm%c .ne. 1) stop 2 + + allocate (j(2)) + j = [lc (rm (2)), lc (rm (3))] ! Segmentation fault + if (any (j%lm%c .ne. [-2,-3])) stop 3 + j = j_ptr () ! Worked! + if (any (j%lm%c .ne. [2,3])) stop 4 + +contains + + function i_ptr () result(res) + type(lc), pointer :: res + res => i + end function + + function j_ptr () result(res) + type(lc), pointer :: res (:) + res => j + end function + +end program bug