diff mbox

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

Message ID 523943D7.607@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Sept. 18, 2013, 6:10 a.m. UTC 
Hi Janus,

(Side remark: That's Janus' email which didn't make it past GCC's mail 
server.)

Janus Weil 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?
> a few comments:
> 1) How about a test case?

I added one - and fixed an issue with gfc_expr_attr for codimension.

> 2) Why not leave in the comment with the F03 reference for now, since
> you're not modifying that part?

Well, the F2003 reference is wrong (its about something else). That's 
not surprising as assignment to an allocatable polymorphic variable is a 
Fortran 2008 feature. (Reading it as F2008 section number leads one to 
the intrinsic assignment section, which is fine.)

> 3) You might wanna modify the FIXME note, since your patch addresses
> at least part of it (namely the invalid-rejection). The only missing
> item now is to allow the things that are valid in F08, I guess.

I have now updated the comment - and made the error message clearer.

Attached is the updated patch.
OK for the trunk?

> Btw, the patch at http://gcc.gnu.org/ml/fortran/2013-08/msg00026.html
> was half-approved by Mikael, but is still waiting for your agreement,
> Tobias, since you had some criticism in the PR ...

Sorry for the delay. However, it seems as if I have now a bit more time 
for GCC/gfortran. I try to get an overview about the August backlog and 
reply to the missing items; in particular to that patch. However, I will 
probably first finish with one review comment and try to create a test 
case for my (committed) defined-assignment patch for ForTrilinos. 
[Followed by backporting that patch to 4.8.]

Tobias

Comments

Janus Weil Sept. 18, 2013, 1:12 p.m. UTC | #1 
Hi,

> (Side remark: That's Janus' email which didn't make it past GCC's mail
> server.)

... for whatever reason. I hope this one will make it through.


>>>> 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?
>>
>> a few comments:
>> 1) How about a test case?
>
> I added one - and fixed an issue with gfc_expr_attr for codimension.

Ok, thanks. I hadn't noticed the codimension problem.


>> 2) Why not leave in the comment with the F03 reference for now, since
>> you're not modifying that part?
>
> Well, the F2003 reference is wrong (its about something else).

No, it's not. F03:7.4.1.2 is about intrinsic assignments, just like F08:7.2.1.2.

However, F03:7.2.1.2 is not (maybe this is what you were looking at?).


> That's not
> surprising as assignment to an allocatable polymorphic variable is a Fortran
> 2008 feature. (Reading it as F2008 section number leads one to the intrinsic
> assignment section, which is fine.)
>
>
>> 3) You might wanna modify the FIXME note, since your patch addresses
>> at least part of it (namely the invalid-rejection). The only missing
>> item now is to allow the things that are valid in F08, I guess.
>
> I have now updated the comment - and made the error message clearer.

Ok, looks better to me. After the realloc-on-assign is fully
implemented, one should replace the "not implemented" error by a
gfc_notify_std, of course (where the F03:7.2.1.2 reference would still
make sense).


> Attached is the updated patch.
> OK for the trunk?

Yes, fine with me. Thanks for the patch.


>> Btw, the patch at http://gcc.gnu.org/ml/fortran/2013-08/msg00026.html
>> was half-approved by Mikael, but is still waiting for your agreement,
>> Tobias, since you had some criticism in the PR ...
>
> Sorry for the delay. However, it seems as if I have now a bit more time for
> GCC/gfortran. I try to get an overview about the August backlog and reply to
> the missing items; in particular to that patch.

That would be great, it's been hanging in there for a while now ...

Cheers,
Janus
diff mbox

Patch

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

	PR fortran/43366
	* primary.c (gfc_variable_attr): Also handle codimension.
	* resolve.c (resolve_ordinary_assign): Add invalid-diagnostic for
	polymorphic assignment.

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

	PR fortran/43366
	* gfortran.dg/class_39.f03: Update dg-error.
	* gfortran.dg/class_5.f03: Ditto.
	* gfortran.dg/class_53.f90: Ditto.
	* gfortran.dg/realloc_on_assign_20.f90: New.
	* gfortran.dg/realloc_on_assign_21.f90: New.
	* gfortran.dg/realloc_on_assign_22.f90: New.

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 1276abb..80d45ea 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2134,7 +2134,7 @@  check_substring:
 symbol_attribute
 gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 {
-  int dimension, pointer, allocatable, target;
+  int dimension, codimension, pointer, allocatable, target;
   symbol_attribute attr;
   gfc_ref *ref;
   gfc_symbol *sym;
@@ -2149,12 +2149,14 @@  gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
     {
       dimension = CLASS_DATA (sym)->attr.dimension;
+      codimension = CLASS_DATA (sym)->attr.codimension;
       pointer = CLASS_DATA (sym)->attr.class_pointer;
       allocatable = CLASS_DATA (sym)->attr.allocatable;
     }
   else
     {
       dimension = attr.dimension;
+      codimension = attr.codimension;
       pointer = attr.pointer;
       allocatable = attr.allocatable;
     }
@@ -2209,11 +2211,13 @@  gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 
 	if (comp->ts.type == BT_CLASS)
 	  {
+	    codimension = CLASS_DATA (comp)->attr.codimension;
 	    pointer = CLASS_DATA (comp)->attr.class_pointer;
 	    allocatable = CLASS_DATA (comp)->attr.allocatable;
 	  }
 	else
 	  {
+	    codimension = comp->attr.codimension;
 	    pointer = comp->attr.pointer;
 	    allocatable = comp->attr.allocatable;
 	  }
@@ -2228,6 +2232,7 @@  gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
       }
 
   attr.dimension = dimension;
+  attr.codimension = codimension;
   attr.pointer = pointer;
   attr.allocatable = allocatable;
   attr.target = target;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fbd9a6a..d33fe49 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9014,6 +9014,7 @@  resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
   int rlen = 0;
   int n;
   gfc_ref *ref;
+  symbol_attribute attr;
 
   if (gfc_extend_assign (code, ns))
     {
@@ -9178,14 +9179,35 @@  resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 	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)
+  /* 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;
+	}
+      /* See PR 43366.  */
+      gfc_error ("Assignment to an allocatable polymorphic variable at %L "
+		 "is not yet supported", &lhs->where);
+      return false;
+    }
+  else 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);
+      gfc_error ("Nonallocatable variable must not be polymorphic in intrinsic "
+		 "assignment at %L - check that there is a matching specific "
+		 "subroutine for '=' operator", &lhs->where);
       return false;
     }
 
diff --git a/gcc/testsuite/gfortran.dg/class_39.f03 b/gcc/testsuite/gfortran.dg/class_39.f03
index 6fe762b..c29a3b0 100644
--- a/gcc/testsuite/gfortran.dg/class_39.f03
+++ b/gcc/testsuite/gfortran.dg/class_39.f03
@@ -8,6 +8,6 @@ 
   end type T
 contains
   class(T) function add()  ! { dg-error "must be dummy, allocatable or pointer" }
-    add = 1  ! { dg-error "Variable must not be polymorphic in intrinsic assignment" }
+    add = 1  ! { dg-error "Nonallocatable variable must not be polymorphic in intrinsic assignment" }
   end function
 end
diff --git a/gcc/testsuite/gfortran.dg/class_5.f03 b/gcc/testsuite/gfortran.dg/class_5.f03
index 087d745..0307cae4 100644
--- a/gcc/testsuite/gfortran.dg/class_5.f03
+++ b/gcc/testsuite/gfortran.dg/class_5.f03
@@ -20,7 +20,7 @@ 
  x = t2(45,478)
  allocate(t2 :: cp)
 
- cp = x   ! { dg-error "Variable must not be polymorphic" }
+ cp = x   ! { dg-error "Nonallocatable variable must not be polymorphic" }
 
  select type (cp)
  type is (t2)
@@ -28,4 +28,3 @@ 
  end select
 
 end
- 
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/class_53.f90 b/gcc/testsuite/gfortran.dg/class_53.f90
index 0a8c962..83f5571 100644
--- a/gcc/testsuite/gfortran.dg/class_53.f90
+++ b/gcc/testsuite/gfortran.dg/class_53.f90
@@ -13,6 +13,6 @@  end type
 type(arr_t) :: this
 class(arr_t) :: elem   ! { dg-error "must be dummy, allocatable or pointer" }
 
-elem = this   ! { dg-error "Variable must not be polymorphic in intrinsic assignment" }
+elem = this   ! { dg-error "Nonallocatable variable must not be polymorphic in intrinsic assignment" }
 
 end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_20.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_20.f90
new file mode 100644
index 0000000..d4cfaf8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_20.f90
@@ -0,0 +1,13 @@ 
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! PR fortran/43366
+!
+! Invalid assignment to an allocatable polymorphic var.
+!
+type t
+end type t
+class(t), allocatable :: var
+
+var = t() ! { dg-error "Fortran 2008: Assignment to an allocatable polymorphic variable" }
+end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_21.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_21.f90
new file mode 100644
index 0000000..fd8f9ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_21.f90
@@ -0,0 +1,13 @@ 
+! { dg-do compile }
+! { dg-options "-fno-realloc-lhs" }
+!
+! PR fortran/43366
+!
+! Invalid assignment to an allocatable polymorphic var.
+!
+type t
+end type t
+class(t), allocatable :: var
+
+var = t() ! { dg-error "Assignment to an allocatable polymorphic variable at .1. requires -frealloc-lhs" }
+end
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_22.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_22.f90
new file mode 100644
index 0000000..f759c6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_22.f90
@@ -0,0 +1,13 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/43366
+!
+! Invalid assignment to an allocatable polymorphic var.
+!
+type t
+end type t
+class(t), allocatable :: caf[:]
+
+caf = t() ! { dg-error "Assignment to polymorphic coarray at .1. is not permitted" }
+end