diff mbox

[Fortran] PR43366 - add invalid-diagnostic for poly assignment

Message ID 5235F05E.8000502@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Sept. 15, 2013, 5:37 p.m. UTC 
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?
diff mbox

Patch

2013-09-15  Tobias Burnus  <burnus@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);