diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2019-02-10 15:52:38 +0000 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2019-02-10 15:52:38 +0000 |
| commit | cedf8d2ee7cf8bb3a5d4d3fe480b257110c0debb (patch) | |
| tree | 66de6950f32c4e85b501ddff96ddb2149f461dd3 /gcc/fortran/expr.c | |
| parent | 1386121ecd068799110d01f01e20e190e3937d25 (diff) | |
re PR fortran/71723 ([F08] ICE on invalid pointer initialization)
2019-02-10 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/71237
* expr.c (gfc_check_assign): Add argument is_init_expr. If we are
looking at an init expression, issue error if the target is not a
TARGET and we are not looking at a procedure pointer.
* gfortran.h (gfc_check_assign): Add optional argument
is_init_expr.
2019-02-10 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/71237
* gfortran.dg/pointer_init_2.f90: Adjust error messages.
* gfortran.dg/pointer_init_6.f90: Likewise.
* gfortran.dg/pointer_init_9.f90: New test.
From-SVN: r268748
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 36 |
1 files changed, 30 insertions, 6 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a0eb94fbbccf..c3d78d358cf6 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3691,7 +3691,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, - bool suppress_type_test) + bool suppress_type_test, bool is_init_expr) { symbol_attribute attr, lhs_attr; gfc_ref *ref; @@ -4133,11 +4133,35 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, return false; } - if (!attr.target && !attr.pointer) + if (is_init_expr) { - gfc_error ("Pointer assignment target is neither TARGET " - "nor POINTER at %L", &rvalue->where); - return false; + gfc_symbol *sym; + bool target; + + gcc_assert (rvalue->symtree); + sym = rvalue->symtree->n.sym; + + if (sym->ts.type == BT_CLASS && sym->attr.class_ok) + target = CLASS_DATA (sym)->attr.target; + else + target = sym->attr.target; + + if (!target && !proc_pointer) + { + gfc_error ("Pointer assignment target in initialization expression " + "does not have the TARGET attribute at %L", + &rvalue->where); + return false; + } + } + else + { + if (!attr.target && !attr.pointer) + { + gfc_error ("Pointer assignment target is neither TARGET " + "nor POINTER at %L", &rvalue->where); + return false; + } } if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) @@ -4271,7 +4295,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) } if (pointer || proc_pointer) - r = gfc_check_pointer_assign (&lvalue, rvalue); + r = gfc_check_pointer_assign (&lvalue, rvalue, false, true); else { /* If a conversion function, e.g., __convert_i8_i4, was inserted |