diff options
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 938dc9a..b8a6a4a 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1,6 +1,6 @@ /* Deal with I/O statements & related stuff. Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, - 2009, 2010 + 2009, 2010, 2011 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -1315,6 +1315,9 @@ match_vtag (const io_tag *tag, gfc_expr **v) return MATCH_ERROR; } + if (gfc_implicit_pure (NULL) && gfc_impure_variable (result->symtree->n.sym)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + *v = result; return MATCH_YES; } @@ -1824,6 +1827,9 @@ gfc_match_open (void) goto cleanup; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + warn = (open->err || open->iostat) ? true : false; /* Checks on NEWUNIT specifier. */ @@ -2238,6 +2244,9 @@ gfc_match_close (void) goto cleanup; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + warn = (close->iostat || close->err) ? true : false; /* Checks on the STATUS specifier. */ @@ -2385,6 +2394,9 @@ done: goto cleanup; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + new_st.op = op; new_st.ext.filepos = fp; return MATCH_YES; @@ -3223,6 +3235,10 @@ if (condition) \ "IO UNIT in %s statement at %C must be " "an internal file in a PURE procedure", io_kind_name (k)); + + if (gfc_implicit_pure (NULL) && (k == M_READ || k == M_WRITE)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + } if (k != M_READ) @@ -3753,6 +3769,9 @@ gfc_match_print (void) return MATCH_ERROR; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + return MATCH_YES; } @@ -3909,6 +3928,9 @@ gfc_match_inquire (void) return MATCH_ERROR; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + new_st.block = gfc_get_code (); new_st.block->op = EXEC_IOLENGTH; terminate_io (code); @@ -3959,6 +3981,9 @@ gfc_match_inquire (void) gfc_error ("INQUIRE statement not allowed in PURE procedure at %C"); goto cleanup; } + + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; if (inquire->id != NULL && inquire->pending == NULL) { @@ -4142,6 +4167,9 @@ gfc_match_wait (void) goto cleanup; } + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + new_st.op = EXEC_WAIT; new_st.ext.wait = wait; |