re PR fortran/46896 (Wrong code with transpose(a) passed to subroutine)

2011-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46896
	* trans-expr.c (gfc_conv_procedure_call): With a non-copying
	procedure argument (eg TRANSPOSE) use a temporary if there is
	any chance of aliasing due to host or use association.
	(arrayfunc_assign_needs_temporary): Correct logic for function
	results and do not use a temporary for implicitly PURE
	variables.  Use a temporary for Cray pointees.
	* symbol.c (gfc_add_save): Explicit SAVE not compatible with
	implicit pureness of containing procedure.
	* decl.c (match_old_style_init, gfc_match_data): Where decl
	would fail in PURE procedure, set implicit_pure to zero.
	* gfortran.h : Add implicit_pure to structure symbol_attr and
	add prototype for function gfc_implicit_pure.
	* expr.c (gfc_check_pointer_assign, gfc_check_vardef_context):
	Where decl would fail in PURE procedure, reset implicit_pure.
	* io.c (match_vtag, gfc_match_open, gfc_match_close,
	gfc_match_print, gfc_match_inquire, gfc_match_wait): The same.
	* match.c (gfc_match_critical, gfc_match_stopcode,
	sync_statement, gfc_match_allocate, gfc_match_deallocate): The
	same.
	* parse.c (decode_omp_directive): The same.
	(parse_contained): If not PURE, set implicit pure attribute.
	* resolve.c (resolve_formal_arglist, resolve_structure_cons,
	resolve_function, resolve_ordinary_assign) : The same.
	(gfc_implicit_pure): New function.
	* module.c (mio_symbol_attribute): Introduce AB_IMPLICIT_PURE
	to ab_attribute enum and use it in this function.

2011-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/46896
	* gfortran.dg/transpose_optimization_2.f90 : New test.

From-SVN: r168600

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;