public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r10-10110] Fortran: Fix for class functions as associated target [PR98565].
@ 2021-09-10 20:49 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2021-09-10 20:49 UTC (permalink / raw)
To: gcc-cvs
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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-09-10 20:49 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-10 20:49 [gcc r10-10110] Fortran: Fix for class functions as associated target [PR98565] Harald Anlauf
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).