Re: [Patch, Fortran, OOP] PR 64209: runtime segfault with CLASS(*), INTENT(OUT) dummy argument

[Janus Weil]

2014-12-19 14:48 GMT+01:00 Tobias Burnus <tobias.bur...@physik.fu-berlin.de>:
> As you write yourself, the issue can only occur for CLASS(*). Hence,
> please apply this only for UNLIMITED_POLY() to avoid unneccessary code side
> increase and performance decrease.

Good point, thanks for reviewing. An updated patch is attached. Will
commit after regtesting.

Cheers,
Janus

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c    (Revision 218957)
+++ gcc/fortran/trans-expr.c    (Arbeitskopie)
@@ -932,6 +932,21 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs,
      of arrays in gfc_trans_call.  */
   res = gfc_trans_call (ppc_code, false, NULL, NULL, false);
   gfc_free_statements (ppc_code);
+
+  if (UNLIMITED_POLY(obj))
+    {
+      /* Check if rhs is non-NULL. */
+      gfc_se src;
+      gfc_init_se (&src, NULL);
+      gfc_conv_expr (&src, rhs);
+      src.expr = gfc_build_addr_expr (NULL_TREE, src.expr);
+      tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+                                  src.expr, fold_convert (TREE_TYPE (src.expr),
+                                                          null_pointer_node));
+      res = build3_loc (input_location, COND_EXPR, TREE_TYPE (res), cond, res,
+                       build_empty_stmt (input_location));
+    }
+
   return res;
 }
 
@@ -980,6 +995,17 @@ gfc_trans_class_init_assign (gfc_code *code)
       src.expr = gfc_build_addr_expr (NULL_TREE, src.expr);
 
       tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
+
+      if (UNLIMITED_POLY(code->expr1))
+       {
+         /* Check if _def_init is non-NULL. */
+         tree cond = fold_build2_loc (input_location, NE_EXPR,
+                                      boolean_type_node, src.expr,
+                                      fold_convert (TREE_TYPE (src.expr),
+                                                    null_pointer_node));
+         tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), cond,
+                           tmp, build_empty_stmt (input_location));
+       }
     }
 
   if (code->expr1->symtree->n.sym->attr.optional