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-10110] Fortran: Fix for class functions as associated target [PR98565]. Date: Fri, 10 Sep 2021 20:49:24 +0000 (GMT) [thread overview] Message-ID: <20210910204924.924F53858401@sourceware.org> (raw) https://gcc.gnu.org/g:755299ea93dd064ab5ec1027a34f30ca2d908f4c commit r10-10110-g755299ea93dd064ab5ec1027a34f30ca2d908f4c Author: Paul Thomas <pault@gcc.gnu.org> Date: Fri Jan 22 17:11:06 2021 +0000 Fortran: Fix for class functions as associated target [PR98565]. 2021-01-22 Paul Thomas <pault@gcc.gnu.org> gcc/fortran PR fortran/98565 * trans-intrinsic.c (gfc_conv_associated): Do not add a _data component for scalar class function targets. Instead, fix the function result and access the _data from that. gcc/testsuite/ PR fortran/98565 * gfortran.dg/associated_target_7.f90 : New test. (cherry picked from commit bf8ee9e4eed6ba1a6d77b4cf168df480e1f954da) Diff: --- gcc/fortran/trans-intrinsic.c | 8 ++- gcc/testsuite/gfortran.dg/associated_target_7.f90 | 87 +++++++++++++++++++++++ 2 files changed, 94 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 29f8f932aa3..43eaba26a87 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8822,7 +8822,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) else { /* An optional target. */ - if (arg2->expr->ts.type == BT_CLASS) + if (arg2->expr->ts.type == BT_CLASS + && arg2->expr->expr_type != EXPR_FUNCTION) gfc_add_data_component (arg2->expr); if (scalar) @@ -8843,6 +8844,11 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) && arg2->expr->symtree->n.sym->attr.dummy) arg2se.expr = build_fold_indirect_ref_loc (input_location, arg2se.expr); + if (arg2->expr->ts.type == BT_CLASS) + { + arg2se.expr = gfc_evaluate_now (arg2se.expr, &arg2se.pre); + arg2se.expr = gfc_class_data_get (arg2se.expr); + } gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); gfc_add_block_to_block (&se->pre, &arg2se.pre); diff --git a/gcc/testsuite/gfortran.dg/associated_target_7.f90 b/gcc/testsuite/gfortran.dg/associated_target_7.f90 new file mode 100644 index 00000000000..97f93b3c742 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_7.f90 @@ -0,0 +1,87 @@ +! { dg-do run } +! +! associated_target_7.f90: Test the fix for PR98565. +! +! Contributed by Yves Secretan <yves.secretan@ete.inrs.ca> +! +MODULE PS_SN0N_M + + IMPLICIT NONE + PRIVATE + + TYPE, PUBLIC :: DT_GRID_T + INTEGER :: NNT + CONTAINS + ! PASS + END TYPE DT_GRID_T + + TYPE, PUBLIC :: LM_ELEM_T + CLASS(DT_GRID_T), POINTER :: PGRID + CONTAINS + PROCEDURE, PUBLIC :: REQPGRID => LM_ELEM_REGPGRID + END TYPE LM_ELEM_T + + TYPE, PUBLIC :: PS_SN0N_T + CLASS(DT_GRID_T), POINTER :: PGRID + + CONTAINS + PROCEDURE, PUBLIC :: ASGOELE => PS_SN0N_ASGOELE + END TYPE PS_SN0N_T + + +CONTAINS + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + FUNCTION LM_ELEM_REGPGRID(SELF) RESULT(PGRID) + CLASS(DT_GRID_T), POINTER :: PGRID + CLASS(LM_ELEM_T), INTENT(IN) :: SELF + PGRID => SELF%PGRID + RETURN + END FUNCTION LM_ELEM_REGPGRID + + !------------------------------------------------------------------------ + !------------------------------------------------------------------------ + FUNCTION PS_SN0N_ASGOELE(SELF, OELE) RESULT(ERMSG) + + INTEGER :: ERMSG + CLASS(PS_SN0N_T), INTENT(IN) :: SELF + CLASS(LM_ELEM_T), INTENT(IN) :: OELE + + !CLASS(DT_GRID_T), POINTER :: PGRID + LOGICAL :: ISOK + !------------------------------------------------------------------------ + + ! ASSOCIATED with temp variable compiles + !PGRID => OELE%REQPGRID() + !ISOK = ASSOCIATED(SELF%PGRID, PGRID) + + ! ASSOCIATE without temp variable crashes with ICE + ISOK = ASSOCIATED(SELF%PGRID, OELE%REQPGRID()) + ERMSG = 0 + IF (ISOK) ERMSG = 1 + + RETURN + END FUNCTION PS_SN0N_ASGOELE + +END MODULE PS_SN0N_M + + + USE PS_SN0N_M + CLASS(PS_SN0N_T), ALLOCATABLE :: SELF + CLASS(LM_ELEM_T), ALLOCATABLE :: OELE + TYPE (DT_GRID_T), TARGET :: GRID1 = DT_GRID_T (42) + TYPE (DT_GRID_T), TARGET :: GRID2 = DT_GRID_T (84) + + ALLOCATE (PS_SN0N_T :: SELF) + ALLOCATE (LM_ELEM_T :: OELE) + SELF%PGRID => GRID1 + + OELE%PGRID => NULL () + IF (SELF%ASGOELE (OELE) .NE. 0) STOP 1 + + OELE%PGRID => GRID2 + IF (SELF%ASGOELE (OELE) .NE. 0) STOP 2 + + OELE%PGRID => GRID1 + IF (SELF%ASGOELE (OELE) .NE. 1) STOP 3 +END
reply other threads:[~2021-09-10 20:49 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=20210910204924.924F53858401@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).