public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r10-10077] Fortran: Fix ICE due to elemental procedure pointers [PR93924/5]. Date: Sat, 28 Aug 2021 19:57:20 +0000 (GMT) [thread overview] Message-ID: <20210828195720.6EF7A3858D34@sourceware.org> (raw) https://gcc.gnu.org/g:bf22e268b5c2a03216503254cfcb828016a7d998 commit r10-10077-gbf22e268b5c2a03216503254cfcb828016a7d998 Author: Paul Thomas <pault@gcc.gnu.org> Date: Wed Jan 27 11:34:02 2021 +0000 Fortran: Fix ICE due to elemental procedure pointers [PR93924/5]. 2021-01-27 Paul Thomas <pault@gcc.gnu.org> gcc/fortran PR fortran/93924 PR fortran/93925 * trans-expr.c (gfc_conv_procedure_call): Suppress the call to gfc_conv_intrinsic_to_class for unlimited polymorphic procedure pointers. (gfc_trans_assignment_1): Similarly suppress class assignment for class valued procedure pointers. gcc/testsuite/ PR fortran/93924 PR fortran/93925 * gfortran.dg/proc_ptr_52.f90 : New test. (cherry picked from commit 4225af228b5d52e8d7593dea49584c91b4bc2e1f) Diff: --- gcc/fortran/trans-expr.c | 6 ++- gcc/testsuite/gfortran.dg/proc_ptr_52.f90 | 72 +++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index dbe6344db99..e2e0946bf09 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5771,7 +5771,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, CLASS_DATA (fsym)->attr.class_pointer || CLASS_DATA (fsym)->attr.allocatable); } - else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS) + else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS + && gfc_expr_attr (e).flavor != FL_PROCEDURE) { /* The intrinsic type needs to be converted to a temporary CLASS object for the unlimited polymorphic formal. */ @@ -11045,7 +11046,8 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, || gfc_is_class_array_ref (expr1, NULL) || gfc_is_class_scalar_expr (expr1) || gfc_is_class_array_ref (expr2, NULL) - || gfc_is_class_scalar_expr (expr2)); + || gfc_is_class_scalar_expr (expr2)) + && lhs_attr.flavor != FL_PROCEDURE; realloc_flag = flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1) diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_52.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90 new file mode 100644 index 00000000000..cb7cf7040a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_52.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +! +! Test the fix for PRs93924 & 93925. +! +! Contributed by Martin Stein <mscfd@gmx.net> +! +module cs + +implicit none + +integer, target :: integer_target + +abstract interface + function classStar_map_ifc(x) result(y) + class(*), pointer :: y + class(*), target, intent(in) :: x + end function classStar_map_ifc +end interface + +contains + + function fun(x) result(y) + class(*), pointer :: y + class(*), target, intent(in) :: x + select type (x) + type is (integer) + integer_target = x ! Deals with dangling target. + y => integer_target + class default + y => null() + end select + end function fun + + function apply(f, x) result(y) + procedure(classStar_map_ifc) :: f + integer, intent(in) :: x + integer :: y + class(*), pointer :: p + y = 0 ! Get rid of 'y' undefined warning + p => f (x) + select type (p) + type is (integer) + y = p + end select + end function apply + + function selector() result(f) + procedure(classStar_map_ifc), pointer :: f + f => fun + end function selector + +end module cs + + +program classStar_map + +use cs +implicit none + +integer :: x, y +procedure(classStar_map_ifc), pointer :: f + +x = 123654 +f => selector () ! Fixed by second chunk in patch +y = apply (f, x) ! Fixed by first chunk in patch +if (x .ne. y) stop 1 + +x = 2 * x +y = apply (fun, x) ! PR93925; fixed as above +if (x .ne. y) stop 2 + +end program classStar_map
reply other threads:[~2021-08-28 19:57 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20210828195720.6EF7A3858D34@sourceware.org \ --to=anlauf@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).