[Bug fortran/50225] [OOP] The allocation status for polymorphic allocatable variables is not set properly

[janus at gcc dot gnu.org]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |ASSIGNED
   Last reconfirmed|                            |2011-08-29
     Ever Confirmed|0                           |1

--- Comment #3 from janus at gcc dot gnu.org 2011-08-29 16:31:29 UTC ---
Preliminary patch which seems to fix the test case:

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c    (revision 178183)
+++ gcc/fortran/trans-decl.c    (working copy)
@@ -5215,17 +5215,25 @@ gfc_generate_function_code (gfc_namespace * ns)
     {
       tree result = get_proc_result (sym);

-      if (result != NULL_TREE
-           && sym->attr.function
-           && !sym->attr.pointer)
+      if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
        {
          if (sym->attr.allocatable && sym->attr.dimension == 0
              && sym->result == sym)
            gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
                                                         null_pointer_node));
+         else if (sym->ts.type == BT_CLASS
+                  && CLASS_DATA (sym)->attr.allocatable
+                  && sym->attr.dimension == 0 && sym->result == sym)
+           {
+             tmp = CLASS_DATA (sym)->backend_decl;
+             tmp = fold_build3_loc (input_location, COMPONENT_REF,
+                                    TREE_TYPE (tmp), result, tmp, NULL_TREE);
+             gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+                                                       null_pointer_node));
+           }
          else if (sym->ts.type == BT_DERIVED
-             && sym->ts.u.derived->attr.alloc_comp
-             && !sym->attr.allocatable)
+                  && sym->ts.u.derived->attr.alloc_comp
+                  && !sym->attr.allocatable)
            {
              rank = sym->as ? sym->as->rank : 0;
              tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);