diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-09-18 20:14:57 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-09-18 20:14:57 +0200 |
| commit | 83ba23b7aa47ed35554dd5654f0e372d824f81e3 (patch) | |
| tree | 800e25b834dfcf4e2501b24f9bce291d8109d684 /gcc/fortran/resolve.c | |
| parent | 3f3fd87d46ec45a4894ae9390424bf7663f771e4 (diff) | |
| download | gcc-83ba23b7aa47ed35554dd5654f0e372d824f81e3.zip gcc-83ba23b7aa47ed35554dd5654f0e372d824f81e3.tar.gz gcc-83ba23b7aa47ed35554dd5654f0e372d824f81e3.tar.bz2 | |
re PR fortran/43366 ([OOP][F08] Intrinsic assign to polymorphic variable)
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.
From-SVN: r202713
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 36 |
1 files changed, 29 insertions, 7 deletions
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; } |