From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id 924F53858401; Fri, 10 Sep 2021 20:49:24 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 924F53858401 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r10-10110] Fortran: Fix for class functions as associated target [PR98565]. X-Act-Checkin: gcc X-Git-Author: Paul Thomas X-Git-Refname: refs/heads/releases/gcc-10 X-Git-Oldrev: 25d45b5dd41a9ab005a5ae8ee8e54be17f2467a2 X-Git-Newrev: 755299ea93dd064ab5ec1027a34f30ca2d908f4c Message-Id: <20210910204924.924F53858401@sourceware.org> Date: Fri, 10 Sep 2021 20:49:24 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 10 Sep 2021 20:49:24 -0000 https://gcc.gnu.org/g:755299ea93dd064ab5ec1027a34f30ca2d908f4c commit r10-10110-g755299ea93dd064ab5ec1027a34f30ca2d908f4c Author: Paul Thomas Date: Fri Jan 22 17:11:06 2021 +0000 Fortran: Fix for class functions as associated target [PR98565]. 2021-01-22 Paul Thomas 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 +! +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