[Bug fortran/54618] [OOP] wrong-code with CLASS(...), INTENT(OUT) -- and OPTIONAL or ALLOCATABLE

[burnus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54618

--- Comment #2 from Tobias Burnus <burnus at gcc dot gnu.org> 2012-09-19 13:31:19 UTC ---
Draft patch for the second issue. Note the FIXME for resetting to the declared
type.

Additionally, the patch fixes only the scalar issue, the same has also to be
done for arrays.

--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3907,9 +3917,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                     allocated on entry, it must be deallocated.  */
-                 if (fsym && fsym->attr.allocatable
-                     && fsym->attr.intent == INTENT_OUT)
+                 if (fsym && fsym->attr.intent == INTENT_OUT
+                     && (fsym->attr.allocatable
+                         || (fsym->ts.type == BT_CLASS
+                             && CLASS_DATA (e)->attr.allocatable)))
                    {
                      stmtblock_t block;
+                     tree ptr;

                      gfc_init_block  (&block);
-                     tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE,
+                     ptr = parmse.expr;
+                     if (e->ts.type == BT_CLASS)
+                       ptr = gfc_class_data_get (ptr);
+
+                     tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
                                                        NULL_TREE, NULL_TREE,
@@ -3919,3 +3936,3 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-                                            void_type_node, parmse.expr,
+                                            void_type_node, ptr,
                                             null_pointer_node);
@@ -3923,2 +3940,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,

+/*                   if (fsym->ts.type == BT_CLASS)
+                       FIXME: Do something similar as
+                       in gfc_trans_class_init_assign.  */
+
                      if (fsym->attr.optional