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
2013-09-15 Tobias Burnus <bur...@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 <bur...@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
