diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2024-11-16 15:56:10 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2024-11-16 15:56:38 +0000 |
| commit | 27ff8049bbdb0a001ba46835cd6a334c4ac76573 (patch) | |
| tree | 65d6bf9096d4c88666ffe20ab84af5fadb7297af | |
| parent | 4a4bd60fa08b9e1079ebead6cb8c3ce82c7f9ef6 (diff) | |
| download | gcc-27ff8049bbdb0a001ba46835cd6a334c4ac76573.zip gcc-27ff8049bbdb0a001ba46835cd6a334c4ac76573.tar.gz gcc-27ff8049bbdb0a001ba46835cd6a334c4ac76573.tar.bz2 | |
Fortran: Fix segmentation fault in defined assignment [PR109066]
2024-11-16 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/109066
* resolve.cc (generate_component_assignments): If the temporary
for 'var' is a pointer and 'expr' is neither a constant or
a variable, change its attribute from pointer to allocatable.
This avoids assignment to a temporary point that has neither
been allocated or associated.
gcc/testsuite/
PR fortran/109066
* gfortran.dg/defined_assignment_12.f90: New test.
| -rw-r--r-- | gcc/fortran/resolve.cc | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/defined_assignment_12.f90 | 61 |
2 files changed, 66 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index b8c908b..e8f780d 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 0000000..57445abe2 --- /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 <abensonca@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 |