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, 42 insertions, 5 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 68eb1aa..42e2593 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1,5 +1,6 @@
 /* Expression translation
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011
    Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
@@ -3078,6 +3079,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		 argument and another one.  */
 	      if (gfc_get_noncopying_intrinsic_argument (e) != NULL)
 		{
+		  gfc_expr *iarg;
 		  sym_intent intent;
 
 		  if (fsym != NULL)
@@ -3088,6 +3090,25 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  if (gfc_check_fncall_dependency (e, intent, sym, args,
 						   NOT_ELEMENTAL))
 		    parmse.force_tmp = 1;
+
+		  iarg = e->value.function.actual->expr;
+
+		  /* Temporary needed if aliasing due to host association.  */
+		  if (sym->attr.contained
+			&& !sym->attr.pure
+			&& !sym->attr.implicit_pure
+			&& !sym->attr.use_assoc
+			&& iarg->expr_type == EXPR_VARIABLE
+			&& sym->ns == iarg->symtree->n.sym->ns)
+		    parmse.force_tmp = 1;
+
+		  /* Ditto within module.  */
+		  if (sym->attr.use_assoc
+			&& !sym->attr.pure
+			&& !sym->attr.implicit_pure
+			&& iarg->expr_type == EXPR_VARIABLE
+			&& sym->module == iarg->symtree->n.sym->module)
+		    parmse.force_tmp = 1;
 		}
 
 	      if (e->expr_type == EXPR_VARIABLE
@@ -3382,7 +3403,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	  /* If the lhs of an assignment x = f(..) is allocatable and
 	     f2003 is allowed, we must do the automatic reallocation.
-	     TODO - deal with instrinsics, without using a temporary.  */
+	     TODO - deal with intrinsics, without using a temporary.  */
 	  if (gfc_option.flag_realloc_lhs
 		&& se->ss && se->ss->loop_chain
 		&& se->ss->loop_chain->is_alloc_lhs
@@ -5376,18 +5397,34 @@ arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
   if (sym->attr.dummy && sym->attr.intent != INTENT_OUT)
     return true;
 
+  /* If the lhs has been host_associated, is in common, a pointer or is
+     a target and the function is not using a RESULT variable, aliasing
+     can occur and a temporary is needed.  */
+  if ((sym->attr.host_assoc
+	   || sym->attr.in_common
+	   || sym->attr.pointer
+	   || sym->attr.cray_pointee
+	   || sym->attr.target)
+	&& expr2->symtree != NULL
+	&& expr2->symtree->n.sym == expr2->symtree->n.sym->result)
+    return true;
+
   /* A PURE function can unconditionally be called without a temporary.  */
   if (expr2->value.function.esym != NULL
       && expr2->value.function.esym->attr.pure)
     return false;
 
-  /* TODO a function that could correctly be declared PURE but is not
-     could do with returning false as well.  */
+  /* Implicit_pure functions are those which could legally be declared
+     to be PURE.  */
+  if (expr2->value.function.esym != NULL
+      && expr2->value.function.esym->attr.implicit_pure)
+    return false;
 
   if (!sym->attr.use_assoc
 	&& !sym->attr.in_common
 	&& !sym->attr.pointer
 	&& !sym->attr.target
+	&& !sym->attr.cray_pointee
 	&& expr2->value.function.esym)
     {
       /* A temporary is not needed if the function is not contained and
@@ -6003,7 +6040,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
 		      bool dealloc)
 {
   tree tmp;
-  
+
   if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
     {
       gfc_error ("Assignment to deferred-length character variable at %L "