diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index e331b5b..3f1141a 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1,6 +1,6 @@ /* Routines for manipulation of expression nodes. Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009, 2010 + 2009, 2010, 2011 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -3227,7 +3227,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { symbol_attribute attr; gfc_ref *ref; - bool is_pure, rank_remap; + bool is_pure, is_implicit_pure, rank_remap; int proc_pointer; if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN @@ -3311,6 +3311,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } is_pure = gfc_pure (NULL); + is_implicit_pure = gfc_implicit_pure (NULL); /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type, kind, etc for lvalue and rvalue must match, and rvalue must be a @@ -3519,6 +3520,10 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) "procedure at %L", &rvalue->where); } + if (is_implicit_pure && gfc_impure_variable (rvalue->symtree->n.sym)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + + if (gfc_has_vector_index (rvalue)) { gfc_error ("Pointer assignment with vector subscript " @@ -4461,6 +4466,9 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) return FAILURE; } + if (!pointer && gfc_implicit_pure (NULL) && gfc_impure_variable (sym)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + /* Check variable definition context for associate-names. */ if (!pointer && sym->assoc) { |