diff mbox series

[fortran] PR98565 - internal compiler error: in conv_function_val, at fortran/trans-expr.c:3950

Message ID CAGkQGiL_0ejgk6rMb2q48p7n+Ew8eck96vfDGhBgUeugJ7srsg@mail.gmail.com
State New
Headers show
Series [fortran] PR98565 - internal compiler error: in conv_function_val, at fortran/trans-expr.c:3950 | expand

Commit Message

Paul Richard Thomas Jan. 22, 2021, 5:17 p.m. UTC 
Fixed as 'obviously correct' as
r11-6863-gbf8ee9e4eed6ba1a6d77b4cf168df480e1f954da

The _data component was preventing the detection of the procedure pointer
component and the conversion of the function. Once diagnosed, the fix is
obvious.

Regtested on FC33/x86_64 - OK in a few weeks for 9- and 10-branches?

Paul

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.

Comments

Thomas Koenig Jan. 22, 2021, 5:26 p.m. UTC | #1 
Hi Paul,

> Regtested on FC33/x86_64 - OK in a few weeks for 9- and 10-branches?

Yes, I think this is obvious enough for a backport.

Thanks for the patch!

Best regards

	Thomas
diff mbox series

Patch

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 0e7c60a906b..5c9258c65c3 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9002,7 +9002,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)
@@ -9023,6 +9024,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);