diff options
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 a0eb94f..c3d78d3 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 |