Re: [Patch, Fortran] PR43366 - add invalid-diagnostic for poly assignment

[Tobias Burnus]

Now with attachment…

Tobias Burnus wrote:

Fortran 2008 permits assignment to polymorphic variables with some constraints. The patch, which was sitting in my tree, adds diagnostic to reject invalid use. For valid code, it runs into the existing not-yet-implemented error.

Build + regtested on x86-64-gnu-linux.
OK for the trunk?

2013-09-15  Tobias Burnus  <bur...@net-b.de>

	PR fortran/43366
	* resolve.c (resolve_ordinary_assign): Add invalid-diagnostic for
	polymorphic assignment.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f2892e2..1157f28 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9010,14 +9010,15 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   bool rval = false;
   gfc_expr *lhs;
   gfc_expr *rhs;
   int llen = 0;
   int rlen = 0;
   int n;
   gfc_ref *ref;
+  symbol_attribute attr;
 
   if (gfc_extend_assign (code, ns))
     {
       gfc_expr** rhsptr;
 
       if (code->op == EXEC_ASSIGN_CALL)
 	{
@@ -9174,15 +9175,34 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 	gfc_current_ns->proc_name->attr.implicit_pure = 0;
 
       /* Fortran 2008, C1283.  */
       if (gfc_is_coindexed (lhs))
 	gfc_current_ns->proc_name->attr.implicit_pure = 0;
     }
 
-  /* F03:7.4.1.2.  */
+  /* F2008, 7.2.1.2.  */
+  attr = gfc_expr_attr (lhs);
+  if (lhs->ts.type == BT_CLASS && attr.allocatable)
+    {
+      if (attr.codimension)
+	{
+	  gfc_error ("Assignment to polymorphic coarray at %L is not "
+		     "permitted", &lhs->where);
+	  return false;
+	}
+      if (!gfc_notify_std (GFC_STD_F2008, "Assignment to an allocatable "
+			   "polymorphic variable at %L", &lhs->where))
+	return false;
+      if (!gfc_option.flag_realloc_lhs)
+	{
+	  gfc_error ("Assignment to an allocatable polymorphic variable at %L "
+		     "requires -frealloc-lhs", &lhs->where);
+	  return false;
+	}
+    }
   /* 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 intrinsic assignment at "
 		 "%L - check that there is a matching specific subroutine "
 		 "for '=' operator", &lhs->where);