diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-11-18 09:16:19 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-11-18 09:16:19 +0000 |
| commit | 83fad92900e6370e4ca4f40cefe56a386399239d (patch) | |
| tree | 733da04272d4bc40f47098cfc29208db9487f595 /gcc/fortran/resolve.c | |
| parent | f163ea822bbd36328ae2af9c47f2fa05ab1077f1 (diff) | |
| download | gcc-83fad92900e6370e4ca4f40cefe56a386399239d.zip gcc-83fad92900e6370e4ca4f40cefe56a386399239d.tar.gz gcc-83fad92900e6370e4ca4f40cefe56a386399239d.tar.bz2 | |
re PR fortran/70260 (ICE: gimplification failed)
2018-11-18 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/70260
* expr.c (gfc_check_assign): Reject assigning to an external
symbol.
(gfc_check_pointer_assign): Add suppress_type_test
argument. Insert line after if. A non-proc pointer can not point
to a constant. Only check types if suppress_type_test is false.
* gfortran.h (gfc_check_pointer_assign): Add optional
suppress_type_test argument.
* resolve.c (gfc_resolve_code): Move up gfc_check_pointer_assign
and give it the extra argument.
(resolve_fl_procedure): Set error on value for a function with
an inizializer.
2018-11-18 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/70260
* gfortran.dg/proc_ptr_result_5.f90: Add dg-error directive.
* gfortran.dg/protected_4.f90: Split line to allow for extra error.
* gfortran.dg/protected_6.f90: Likewise.
* gfortran.dg/assign_11.f90: New test.
* gfortran.dg/pointer_assign_12.f90: New test.
From-SVN: r266248
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 8 |
1 files changed, 6 insertions, 2 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ba96234..df7c6cb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -11420,11 +11420,12 @@ start: t = gfc_check_vardef_context (e, false, false, false, _("pointer assignment")); gfc_free_expr (e); + + t = gfc_check_pointer_assign (code->expr1, code->expr2, !t) && t; + if (!t) break; - gfc_check_pointer_assign (code->expr1, code->expr2); - /* Assigning a class object always is a regular assign. */ if (code->expr2->ts.type == BT_CLASS && code->expr1->ts.type == BT_CLASS @@ -12540,6 +12541,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_error ("Function %qs at %L cannot have an initializer", sym->name, &sym->declared_at); + + /* Make sure no second error is issued for this. */ + sym->value->error = 1; return false; } |