diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2025-01-27 09:55:26 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2025-01-27 09:56:14 +0000 |
| commit | 3600b1ff14a459e84bb40bdfea7cd8d2ffd73d8d (patch) | |
| tree | 08d19f53a992e29909dedf046ae43c2adfe8e744 | |
| parent | 92a5c5100c25190622ca86b63586a598952546bf (diff) | |
| download | gcc-3600b1ff14a459e84bb40bdfea7cd8d2ffd73d8d.zip gcc-3600b1ff14a459e84bb40bdfea7cd8d2ffd73d8d.tar.gz gcc-3600b1ff14a459e84bb40bdfea7cd8d2ffd73d8d.tar.bz2 | |
Fortran: ICE in gfc_conv_expr_present w. defined assignment [PR118640]
2025-01-27 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/118640
* resolve.cc (generate_component_assignments): Make sure that
the rhs temporary does not pick up the optional attribute from
the lhs.
gcc/testsuite/
PR fortran/118640
* gfortran.dg/pr118640.f90: New test.
| -rw-r--r-- | gcc/fortran/resolve.cc | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr118640.f90 | 38 |
2 files changed, 43 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 124f4ac..7f73d53 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -13383,7 +13383,12 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) tmp_expr = get_temp_from_expr ((*code)->expr1, ns); if (tmp_expr->symtree->n.sym->attr.pointer) { + /* Use allocate on assignment for the sake of simplicity. The + temporary must not take on the optional attribute. Assume + that the assignment is guarded by a PRESENT condition if the + lhs is optional. */ tmp_expr->symtree->n.sym->attr.pointer = 0; + tmp_expr->symtree->n.sym->attr.optional = 0; tmp_expr->symtree->n.sym->attr.allocatable = 1; } this_code = build_assignment (EXEC_ASSIGN, diff --git a/gcc/testsuite/gfortran.dg/pr118640.f90 b/gcc/testsuite/gfortran.dg/pr118640.f90 new file mode 100644 index 0000000..8f74dbf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr118640.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! +! Check the fix for an ICE in gfc_conv_expr_present, which resulted from +! the rhs temporary picking up the optional attribute from the lhs in a +! defined assignment. +! +! Contributed by Jakub Jelenik <jakub@gcc.gnu.org> +! +module foo + type t1 + contains + procedure bar + generic :: assignment(=) => bar + end type + type t2 + type(t1) m + end type +contains + subroutine bar (x, y) + intent(in) y + class(t1), intent(out) :: x + end subroutine +end module +subroutine baz (x, y) + use foo + integer y + type(t2), pointer, optional :: x + interface + function qux (x) + use foo + integer x + type(t2) qux + end function + end interface + if (present (x)) then + x = qux (y) ! ICE was here + end if +end subroutine |