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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@168600 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 238 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f313fd8e2df..f24c22f7016 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,33 @@
+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  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/45777
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0dbda0bfb20..638a7386d15 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1,5 +1,5 @@
 /* Declaration statement matcher
-   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -502,6 +502,9 @@ match_old_style_init (const char *name)
       return MATCH_ERROR;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   /* Mark the variable as having appeared in a data statement.  */
   if (gfc_add_data (&sym->attr, sym->name, &sym->declared_at) == FAILURE)
     {
@@ -560,6 +563,9 @@ gfc_match_data (void)
       return MATCH_ERROR;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   return MATCH_YES;
 
 cleanup:
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index e331b5b2cf7..3f1141a0e0b 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)
     {
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1444ee8ef65..d0377f97457 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1,6 +1,6 @@
 /* gfortran header file
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010
+   2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -723,6 +723,11 @@ typedef struct
   unsigned sequence:1, elemental:1, pure:1, recursive:1;
   unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
 
+  /* This is set if a contained procedure could be declared pure.  This is
+     used for certain optimizations that require the result or arguments
+     cannot alias.  Note that this is zero for PURE procedures.  */
+  unsigned implicit_pure:1;
+
   /* This is set if the subroutine doesn't return.  Currently, this
      is only possible for intrinsic subroutines.  */
   unsigned noreturn:1;
@@ -2736,6 +2741,7 @@ void gfc_resolve (gfc_namespace *);
 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
 int gfc_impure_variable (gfc_symbol *);
 int gfc_pure (gfc_symbol *);
+int gfc_implicit_pure (gfc_symbol *);
 int gfc_elemental (gfc_symbol *);
 gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
 gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 938dc9a9224..b8a6a4a3075 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;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a74fdb7fc98..926fea7ee53 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1,7 +1,7 @@
 /* Matching subroutines in all sizes, shapes and colors.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010
-   2010 Free Software Foundation, Inc.
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -1746,6 +1746,9 @@ gfc_match_critical (void)
       return MATCH_ERROR;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CRITICAL statement at %C")
       == FAILURE)
     return MATCH_ERROR;
@@ -2189,6 +2192,9 @@ gfc_match_stopcode (gfc_statement st)
       goto cleanup;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   if (st == ST_STOP && gfc_find_state (COMP_CRITICAL) == SUCCESS)
     {
       gfc_error ("Image control statement STOP at %C in CRITICAL block");
@@ -2321,6 +2327,9 @@ sync_statement (gfc_statement st)
       return MATCH_ERROR;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SYNC statement at %C")
       == FAILURE)
     return MATCH_ERROR;
@@ -2920,6 +2929,10 @@ gfc_match_allocate (void)
 	  goto cleanup;
 	}
 
+      if (gfc_implicit_pure (NULL)
+	    && gfc_impure_variable (tail->expr->symtree->n.sym))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
       if (tail->expr->ts.deferred)
 	{
 	  saw_deferred = true;
@@ -3263,6 +3276,9 @@ gfc_match_deallocate (void)
 	  goto cleanup;
 	}
 
+      if (gfc_implicit_pure (NULL) && gfc_impure_variable (sym))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
       /* FIXME: disable the checking on derived types.  */
       b1 = !(tail->expr->ref
 	   && (tail->expr->ref->type == REF_COMPONENT
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index f75e3fd5837..8de19273f34 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1,7 +1,7 @@
 /* Handle modules, which amounts to loading and saving symbols and
    their attendant structures.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010
+   2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1675,7 +1675,8 @@ typedef enum
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
   AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
   AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
-  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER
+  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
+  AB_IMPLICIT_PURE
 }
 ab_attribute;
 
@@ -1725,6 +1726,7 @@ static const mstring attr_bits[] =
     minit ("VTYPE", AB_VTYPE),
     minit ("VTAB", AB_VTAB),
     minit ("CLASS_POINTER", AB_CLASS_POINTER),
+    minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
     minit (NULL, -1)
 };
 
@@ -1859,6 +1861,8 @@ mio_symbol_attribute (symbol_attribute *attr)
 	MIO_NAME (ab_attribute) (AB_ELEMENTAL, attr_bits);
       if (attr->pure)
 	MIO_NAME (ab_attribute) (AB_PURE, attr_bits);
+      if (attr->implicit_pure)
+	MIO_NAME (ab_attribute) (AB_IMPLICIT_PURE, attr_bits);
       if (attr->recursive)
 	MIO_NAME (ab_attribute) (AB_RECURSIVE, attr_bits);
       if (attr->always_explicit)
@@ -1990,6 +1994,9 @@ mio_symbol_attribute (symbol_attribute *attr)
 	    case AB_PURE:
 	      attr->pure = 1;
 	      break;
+	    case AB_IMPLICIT_PURE:
+	      attr->implicit_pure = 1;
+	      break;
 	    case AB_RECURSIVE:
 	      attr->recursive = 1;
 	      break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 58d8b43065e..e7898cc5621 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1,6 +1,6 @@
 /* Main parser.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010
+   2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -495,6 +495,9 @@ decode_omp_directive (void)
       return ST_NONE;
     }
 
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   old_locus = gfc_current_locus;
 
   /* General OpenMP directive matching: Instead of testing every possible
@@ -3850,6 +3853,12 @@ parse_contained (int module)
 	  sym->attr.contained = 1;
 	  sym->attr.referenced = 1;
 
+	  /* Set implicit_pure so that it can be reset if any of the
+	     tests for purity fail.  This is used for some optimisation
+	     during translation.  */
+	  if (!sym->attr.pure)
+	    sym->attr.implicit_pure = 1;
+
 	  parse_progunit (ST_NONE);
 
 	  /* Fix up any sibling functions that refer to this one.  */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1d8a7b6a2e7..fec84cc71e9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1,5 +1,6 @@
 /* Perform type resolution on the various structures.
-   Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -273,6 +274,9 @@ resolve_formal_arglist (gfc_symbol *proc)
 	      continue;
 	    }
 
+	  if (proc->attr.implicit_pure && !gfc_pure(sym))
+	    proc->attr.implicit_pure = 0;
+
 	  if (gfc_elemental (proc))
 	    {
 	      gfc_error ("Dummy procedure at %L not allowed in ELEMENTAL "
@@ -345,6 +349,16 @@ resolve_formal_arglist (gfc_symbol *proc)
 		       &sym->declared_at);
 	}
 
+      if (proc->attr.implicit_pure && !sym->attr.pointer
+	  && sym->attr.flavor != FL_PROCEDURE)
+	{
+	  if (proc->attr.function && sym->attr.intent != INTENT_IN)
+	    proc->attr.implicit_pure = 0;
+
+	  if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
+	    proc->attr.implicit_pure = 0;
+	}
+
       if (gfc_elemental (proc))
 	{
 	  /* F2008, C1289.  */
@@ -1124,6 +1138,12 @@ resolve_structure_cons (gfc_expr *expr, int init)
 		     comp->name, &cons->expr->where);
 	}
 
+      if (gfc_implicit_pure (NULL)
+	    && cons->expr->expr_type == EXPR_VARIABLE
+	    && (gfc_impure_variable (cons->expr->symtree->n.sym)
+		|| gfc_is_coindexed (cons->expr)))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
     }
 
   return t;
@@ -3067,6 +3087,9 @@ resolve_function (gfc_expr *expr)
 	}
     }
 
+  if (!pure_function (expr, &name) && name && gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   /* Functions without the RECURSIVE attribution are not allowed to
    * call themselves.  */
   if (expr->value.function.esym && !expr->value.function.esym->attr.recursive)
@@ -8812,6 +8835,26 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 	}
     }
 
+  if (gfc_implicit_pure (NULL))
+    {
+      if (lhs->expr_type == EXPR_VARIABLE
+	    && lhs->symtree->n.sym != gfc_current_ns->proc_name
+	    && lhs->symtree->n.sym->ns != gfc_current_ns)
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      if (lhs->ts.type == BT_DERIVED
+	    && lhs->expr_type == EXPR_VARIABLE
+	    && lhs->ts.u.derived->attr.pointer_comp
+	    && rhs->expr_type == EXPR_VARIABLE
+	    && (gfc_impure_variable (rhs->symtree->n.sym)
+		|| gfc_is_coindexed (rhs)))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      /* Fortran 2008, C1283.  */
+      if (gfc_is_coindexed (lhs))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+    }
+
   /* F03:7.4.1.2.  */
   /* FIXME: Valid in Fortran 2008, unless the LHS is both polymorphic
      and coindexed; cf. F2008, 7.2.1.2 and PR 43366.  */
@@ -12764,6 +12807,34 @@ gfc_pure (gfc_symbol *sym)
 }
 
 
+/* Test whether a symbol is implicitly pure or not.  For a NULL pointer,
+   checks if the current namespace is implicitly pure.  Note that this
+   function returns false for a PURE procedure.  */
+
+int
+gfc_implicit_pure (gfc_symbol *sym)
+{
+  symbol_attribute attr;
+
+  if (sym == NULL)
+    {
+      /* Check if the current namespace is implicit_pure.  */
+      sym = gfc_current_ns->proc_name;
+      if (sym == NULL)
+	return 0;
+      attr = sym->attr;
+      if (attr.flavor == FL_PROCEDURE
+	    && attr.implicit_pure && !attr.pure)
+	return 1;
+      return 0;
+    }
+
+  attr = sym->attr;
+
+  return attr.flavor == FL_PROCEDURE && attr.implicit_pure && !attr.pure;
+}
+
+
 /* Test whether the current procedure is elemental or not.  */
 
 int
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 1a385b5f7bb..cb5a08f87e0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1,6 +1,6 @@
 /* Maintain binary trees of symbols.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010
+   2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -1110,6 +1110,9 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
       return FAILURE;
     }
 
+  if (s == SAVE_EXPLICIT && gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
   if (s == SAVE_EXPLICIT && attr->save == SAVE_EXPLICIT)
     {
 	if (gfc_notify_std (GFC_STD_LEGACY, 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 68eb1aaa5ef..42e259354d1 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 "