[gcc r10-10110] Fortran: Fix for class functions as associated target [PR98565].

[gcc r10-10110] Fortran: Fix for class functions as associated target [PR98565].

[Harald Anlauf]

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