[Patch, fortran] PR109066 - Segfault when using defined assignment

[Paul Richard Thomas]

Hi All,

This is a particularly straightforward, going on 'obvious',  patch. The bug
goes back to at least gcc-6.4.1.

OK for mainline and, after a week or two, to 13- and 14-branches?

Regards

Paul

Change.Logs
Description: Binary data

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  <abenso...@gcc.gnu.org>
+!
+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