[Bug fortran/43366] [OOP][F2008] Intrinsic assign to polymorphic variable

[janus at gcc dot gnu.org]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |ASSIGNED
         AssignedTo|unassigned at gcc dot       |janus at gcc dot gnu.org
                   |gnu.org                     |

--- Comment #10 from janus at gcc dot gnu.org 2011-02-10 22:41:47 UTC ---
The following patch makes the test case in comment #3 work correctly:


Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c    (revision 169986)
+++ gcc/fortran/trans-expr.c    (working copy)
@@ -5838,6 +5838,14 @@ is_scalar_reallocatable_lhs (gfc_expr *expr)
     && !expr->ref)
     return true;

+  /* An allocatable class variable with no reference.  */
+  if (expr->symtree->n.sym->ts.type == BT_CLASS
+      && CLASS_DATA (expr->symtree->n.sym)->attr.allocatable
+      && expr->ref && expr->ref->type == REF_COMPONENT
+      && strcmp (expr->ref->u.c.component->name, "_data") == 0
+      && expr->ref->next == NULL)
+    return true;
+
   /* All that can be left are allocatable components.  */
   if ((expr->symtree->n.sym->ts.type != BT_DERIVED
     && expr->symtree->n.sym->ts.type != BT_CLASS)
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c    (revision 169987)
+++ gcc/fortran/resolve.c    (working copy)
@@ -8881,14 +8881,32 @@ resolve_ordinary_assign (gfc_code *code, gfc_names
     gfc_current_ns->proc_name->attr.implicit_pure = 0;
     }

-  /* F03:7.4.1.2.  */
-  /* FIXME: Valid in Fortran 2008, unless the LHS is both polymorphic
-     and coindexed; cf. F2008, 7.2.1.2 and PR 43366.  */
   if (lhs->ts.type == BT_CLASS)
     {
-      gfc_error ("Variable must not be polymorphic in assignment at %L",
-         &lhs->where);
-      return false;
+      /* F08:7.2.1.2.  */
+      if (!gfc_expr_attr (lhs).allocatable)
+    {
+      gfc_error ("Polymorphic variable in intrinsinc assignment must be "
+             "allocatable at %L", &lhs->where);
+      return false;
+    }
+      else if (gfc_expr_attr (lhs).codimension)
+    {
+      gfc_error ("Polymorphic variable in intrinsinc assignment must not be"
+             " coarray at %L", &lhs->where);
+      return false;
+    }
+      else if (gfc_is_coindexed (lhs))
+    {
+      gfc_error ("Polymorphic variable in intrinsinc assignment must not be"
+             " coindexed at %L", &lhs->where);
+      return false;
+    }
+      /* F03:7.4.1.2.  */
+      else if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Variable must not
"
+                   "be polymorphic in assignment at %L",
+                   &lhs->where) == FAILURE)
+    return false;
     }

   /* F2008, Section 7.2.1.2.  */