aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/fortran/primary.c7
-rw-r--r--gcc/fortran/resolve.c36
-rw-r--r--gcc/testsuite/ChangeLog10
-rw-r--r--gcc/testsuite/gfortran.dg/class_39.f032
-rw-r--r--gcc/testsuite/gfortran.dg/class_5.f033
-rw-r--r--gcc/testsuite/gfortran.dg/class_53.f902
-rw-r--r--gcc/testsuite/gfortran.dg/realloc_on_assign_20.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/realloc_on_assign_21.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/realloc_on_assign_22.f9013
10 files changed, 94 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 37c5950..d236ce3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2013-09-18 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-16 Tobias Burnus <burnus@net-b.de>
PR fortran/58356
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/ChangeLog b/gcc/testsuite/ChangeLog
index 60c0baa..e388eb4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2013-09-18 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.
+
2013-09-18 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/58457
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
generated by cgit v1.1 at 2025-06-02 07:48:23 +0000