[Patch, Fortran, OOP] PR 78848: [7 Regression] ICE on writing CLASS variable with non-typebound DTIO procedure

[Janus Weil]

Hi all,

the attached patch fixes an ICE on a valid DTIO example, which is in
fact a regression of one of my recent patches. See bugzilla for
details.

Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2016-12-18  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/78848
    * trans-io.c (get_dtio_proc): Generate non-typebound DTIO call for class
    variables, if no typebound DTIO procedure is available.

2016-12-18  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/78848
    * gfortran.dg/dtio_22.f90: New test.
-------------- next part --------------
Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c	(revision 243776)
+++ gcc/fortran/trans-io.c	(working copy)
@@ -2180,9 +2180,31 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code,
       formatted = true;
     }
 
-  if (ts->type == BT_DERIVED)
+  if (ts->type == BT_CLASS)
+    derived = ts->u.derived->components->ts.u.derived;
+  else
+    derived = ts->u.derived;
+
+  gfc_symtree *tb_io_st = gfc_find_typebound_dtio_proc (derived,
+						  last_dt == WRITE, formatted);
+  if (ts->type == BT_CLASS && tb_io_st)
     {
-      derived = ts->u.derived;
+      // polymorphic DTIO call  (based on the dynamic type)
+      gfc_se se;
+      gfc_expr *expr = gfc_find_and_cut_at_last_class_ref (code->expr1);
+      gfc_add_vptr_component (expr);
+      gfc_add_component_ref (expr,
+			     tb_io_st->n.tb->u.generic->specific_st->name);
+      *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym;
+      gfc_init_se (&se, NULL);
+      se.want_pointer = 1;
+      gfc_conv_expr (&se, expr);
+      gfc_free_expr (expr);
+      return se.expr;
+    }
+  else
+    {
+      // non-polymorphic DTIO call (based on the declared type)
       *dtio_sub = gfc_find_specific_dtio_proc (derived, last_dt == WRITE,
 					      formatted);
 
@@ -2189,32 +2211,8 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code,
       if (*dtio_sub)
 	return gfc_build_addr_expr (NULL, gfc_get_symbol_decl (*dtio_sub));
     }
-  else if (ts->type == BT_CLASS)
-    {
-      gfc_symtree *tb_io_st;
 
-      derived = ts->u.derived->components->ts.u.derived;
-      tb_io_st = gfc_find_typebound_dtio_proc (derived,
-					       last_dt == WRITE, formatted);
-      if (tb_io_st)
-	{
-	  gfc_se se;
-	  gfc_expr *expr = gfc_find_and_cut_at_last_class_ref (code->expr1);
-	  gfc_add_vptr_component (expr);
-	  gfc_add_component_ref (expr,
-				 tb_io_st->n.tb->u.generic->specific_st->name);
-	  *dtio_sub = tb_io_st->n.tb->u.generic->specific->u.specific->n.sym;
-	  gfc_init_se (&se, NULL);
-	  se.want_pointer = 1;
-	  gfc_conv_expr (&se, expr);
-	  gfc_free_expr (expr);
-	  return se.expr;
-	}
-    }
-
-
   return NULL_TREE;
-
 }
 
 /* Generate the call for a scalar transfer node.  */
-------------- next part --------------
A non-text attachment was scrubbed...
Name: dtio_22.f90
Type: text/x-fortran
Size: 767 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/fortran/attachments/20161218/ac50120d/attachment.bin>