Index: fortran/dump-parse-tree.c
===================================================================
--- fortran/dump-parse-tree.c	(Revision 278025)
+++ fortran/dump-parse-tree.c	(Arbeitskopie)
@@ -57,6 +57,15 @@ static void show_attr (symbol_attribute *, const c
 /* Allow dumping of an expression in the debugger.  */
 void gfc_debug_expr (gfc_expr *);
 
+void debug (gfc_namespace *ns)
+{
+  FILE *tmp = dumpfile;
+  dumpfile = stderr;
+  show_namespace (ns);
+  fputc ('\n', dumpfile);
+  dumpfile = tmp;
+}
+
 void debug (symbol_attribute *attr)
 {
   FILE *tmp = dumpfile;
@@ -1889,6 +1898,9 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_INIT_ASSIGN:
+      fputs ("INIT_", dumpfile);
+      /* Fallthrough */
+
     case EXEC_ASSIGN:
       fputs ("ASSIGN ", dumpfile);
       show_expr (c->expr1);
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c	(Revision 278025)
+++ fortran/frontend-passes.c	(Arbeitskopie)
@@ -57,6 +57,7 @@ static int call_external_blas (gfc_code **, int *,
 static int matmul_temp_args (gfc_code **, int *,void *data);
 static int index_interchange (gfc_code **, int*, void *);
 static bool is_fe_temp (gfc_expr *e);
+static void replace_intent_in (gfc_namespace *);
 
 #ifdef CHECKING_P
 static void check_locus (gfc_namespace *);
@@ -1467,6 +1468,7 @@ optimize_namespace (gfc_namespace *ns)
 
   if (flag_frontend_optimize)
     {
+      replace_intent_in (ns);
       gfc_code_walker (&ns->code, simplify_io_impl_do, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_elseif, dummy_expr_callback, NULL);
@@ -4969,7 +4971,7 @@ gfc_expr_walker (gfc_expr **e, walk_expr_fn_t expr
 	    if ((*e)->expr_type != EXPR_ARRAY)
 	      break;
 
-	    /* Fall through to the variable case in order to walk the
+ 	    /* Fall through to the variable case in order to walk the
 	       reference.  */
 	    gcc_fallthrough ();
 
@@ -5503,3 +5505,330 @@ gfc_check_externals (gfc_namespace *ns)
 
   gfc_errors_to_warnings (false);
 }
+
+/*  For scalar INTENT(IN) variables or for variables where we know
+    their value is not changed, we can replace them by an auxiliary
+    variable whose value is set on procedure entry.  */
+
+typedef struct sym_replacement
+{
+  gfc_symbol *original;
+  gfc_symtree *replacement_symtree;
+  bool referenced;
+
+} sym_replace;
+
+/* Callback function - replace expression if possible, and set
+   sr->referenced if this was done (so we know we need to generate
+   the assignment statement).  */
+
+static int
+replace_symbol_in_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+			void *data)
+{
+  gfc_expr *expr = *e;
+  sym_replacement *sr;
+
+  if (expr->expr_type != EXPR_VARIABLE || expr->symtree == NULL)
+    return 0;
+
+  sr = (sym_replacement *) data;
+
+  if (expr->symtree->n.sym == sr->original)
+    {
+      expr->symtree = sr->replacement_symtree;
+      sr->referenced = true;
+    }
+
+  return 0;
+}
+
+/* Callback to check if the symbol passed as data could be redefined.
+   Return 1 if this is the case.  */
+
+#define CHECK_TAG(member,tag)						\
+      do 								\
+	{ 								\
+	  if (co->ext.member->tag && co->ext.member->tag->symtree	\
+	      && co->ext.member->tag->symtree->n.sym == sym)		\
+	  return 1;							\
+	} while (0)
+
+static gfc_exec_op last_readwrite;
+
+/* Callback to determine if the symbol is defined somewhere for a
+   gfc_code.  Passing an argument to a subroutine as an argument
+   which is not an INTENT(IN) counts as being modified.  */
+
+static int
+defined_code_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+		      void *data)
+{
+  gfc_code *co = *c;
+  gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  sym = (gfc_symbol *) data;
+
+  switch (co->op)
+    {
+    case EXEC_IOLENGTH:
+      last_readwrite = EXEC_IOLENGTH;
+      /* Fall through.  */
+    case EXEC_ASSIGN:
+    case EXEC_LABEL_ASSIGN:
+      if (co->expr1->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_OPEN:
+      CHECK_TAG (open, iostat);
+      CHECK_TAG (open, iomsg);
+      CHECK_TAG (open, newunit);
+      break;
+      
+    case EXEC_CLOSE:
+      CHECK_TAG (close, iostat);
+      CHECK_TAG (close, iomsg);
+      break;
+
+    case EXEC_BACKSPACE:
+    case EXEC_ENDFILE:
+    case EXEC_REWIND:
+    case EXEC_FLUSH:
+      CHECK_TAG (filepos, iostat);
+      CHECK_TAG (filepos, iomsg);
+      break;
+
+    case EXEC_INQUIRE:
+      CHECK_TAG (inquire, iomsg);
+      CHECK_TAG (inquire, iostat);
+      CHECK_TAG (inquire, exist);
+      CHECK_TAG (inquire, opened);
+      CHECK_TAG (inquire, number);
+      CHECK_TAG (inquire, named);
+      CHECK_TAG (inquire, name);
+      CHECK_TAG (inquire, access);
+      CHECK_TAG (inquire, sequential);
+      CHECK_TAG (inquire, direct);
+      CHECK_TAG (inquire, form);
+      CHECK_TAG (inquire, formatted);
+      CHECK_TAG (inquire, unformatted);
+      CHECK_TAG (inquire, recl);
+      CHECK_TAG (inquire, nextrec);
+      CHECK_TAG (inquire, blank);
+      CHECK_TAG (inquire, position);
+      CHECK_TAG (inquire, action);
+      CHECK_TAG (inquire, read);
+      CHECK_TAG (inquire, write);
+      CHECK_TAG (inquire, readwrite);
+      CHECK_TAG (inquire, delim);
+      CHECK_TAG (inquire, encoding);
+      CHECK_TAG (inquire, pad);
+      CHECK_TAG (inquire, iolength);
+      CHECK_TAG (inquire, convert);
+      CHECK_TAG (inquire, strm_pos);
+      CHECK_TAG (inquire, asynchronous);
+      CHECK_TAG (inquire, decimal);
+      CHECK_TAG (inquire, pending);
+      CHECK_TAG (inquire, id);
+      CHECK_TAG (inquire, sign);
+      CHECK_TAG (inquire, size);
+      CHECK_TAG (inquire, round);
+      break;
+
+    case EXEC_WAIT:
+      CHECK_TAG (wait, iostat);
+      CHECK_TAG (wait, iomsg);
+      break;
+
+    case EXEC_READ:
+      last_readwrite = EXEC_READ;
+      CHECK_TAG (dt, iostat);
+      CHECK_TAG (dt, iomsg);
+      CHECK_TAG (dt, id);
+      break;
+
+    case EXEC_WRITE:
+      last_readwrite = EXEC_WRITE;
+      CHECK_TAG (dt, iostat);
+      CHECK_TAG (dt, iomsg);
+      CHECK_TAG (dt, id);
+      break;
+
+    case EXEC_DT_END:
+      last_readwrite = EXEC_NOP;
+      break;
+
+    case EXEC_TRANSFER:
+      if (last_readwrite == EXEC_READ && co->expr1
+	  && co->expr1->expr_type == EXPR_VARIABLE
+	  && co->expr1->symtree && co->expr1->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_DO:
+      if (co->ext.iterator && co->ext.iterator->var->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_CALL:
+      if (co->resolved_sym == NULL)
+	return 1;
+
+      f = gfc_sym_get_dummy_args (co->resolved_sym);
+      for (a = co->ext.actual; a; a = a->next)
+	{
+	  if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == sym)
+	    {
+	      if (f == NULL || f->sym == NULL)
+		return 1;
+
+	      if (f->sym->attr.intent != INTENT_IN)
+		return 1;
+	    }
+	  if (f)
+	    f = f->next;
+	}
+      break;
+
+    default:
+      break;
+    }
+  return 0;
+
+}
+
+#undef CHECK_TAG
+
+/* Callback to determine if the symbol is defined as an argument to a
+   function.  Passing to a function as an argument which is not an
+   INTENT(IN) counts as being modified.  */
+
+static int
+defined_expr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+		       void *data)
+{
+  gfc_expr *expr = *e;
+  gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  if (expr->expr_type != EXPR_FUNCTION || expr->value.function.isym)
+    return 0;
+
+  sym = (gfc_symbol *) data;
+  f = gfc_sym_get_dummy_args (expr->symtree->n.sym);
+
+  for (a = expr->value.function.actual; a ; a = a->next)
+    {
+      if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == sym)
+	{
+	  if (f == NULL || f->sym == NULL)
+	    return 1;
+
+	  if (f->sym->attr.intent != INTENT_IN)
+	    return 1;
+	}
+      if (f)
+	f = f->next;
+    }
+  return 0;
+}
+
+/* Replace INTENT(IN) scalar variables by assigning their values to
+   temporary variables.  We really only want to use this for the
+   simplest cases, all the fancy stuff is excluded.  */
+
+static void
+replace_intent_in (gfc_namespace *ns)
+{
+  gfc_formal_arglist *f;
+  gfc_namespace *ns_c;
+  gfc_code **c;
+
+  if (ns == NULL || ns->proc_name == NULL || gfc_elemental (ns->proc_name)
+      || ns->proc_name->attr.entry_master)
+    return;
+
+  for (f = ns->proc_name->formal; f; f = f->next)
+    {
+      if (f->sym == NULL || f->sym->attr.dimension || f->sym->attr.allocatable
+	  || f->sym->attr.optional || f->sym->attr.pointer
+	  || f->sym->attr.codimension || f->sym->attr.value
+	  || f->sym->attr.proc_pointer || f->sym->attr.target
+	  || f->sym->attr.asynchronous || f->sym->attr.volatile_
+	  || f->sym->attr.procedure
+	  || f->sym->ts.type == BT_CHARACTER || f->sym->ts.type == BT_DERIVED
+	  || f->sym->ts.type == BT_CLASS || f->sym->ts.type == BT_UNKNOWN
+	  || f->sym->attr.intent == INTENT_OUT)
+	continue;
+
+      if (f->sym->attr.intent == INTENT_IN
+	  || gfc_code_walker (&ns->code, defined_code_callback,
+			      defined_expr_callback, (void *) f->sym) == 0)
+	{
+	  gfc_symtree *symtree;
+	  gfc_symbol *replacement;
+	  sym_replace sr;
+
+	  char name[GFC_MAX_SYMBOL_LEN + 1];
+	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
+		    f->sym->name);
+
+	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
+	    gcc_unreachable ();
+
+	  replacement = symtree->n.sym;
+	  replacement->ts = f->sym->ts;
+	  replacement->attr.flavor = FL_VARIABLE;
+	  replacement->attr.fe_temp = 1;
+	  replacement->attr.referenced = 1;
+	  replacement->declared_at = f->sym->declared_at;
+	  gfc_commit_symbol (replacement);
+
+	  sr.original = f->sym;
+	  sr.replacement_symtree = symtree;
+	  sr.referenced = false;
+
+	  /* Skip any INIT_ASSIGN statements at the beginning.  */
+	  for (c = &ns->code; *c != NULL && (*c)->op == EXEC_INIT_ASSIGN;
+	       c = &(*c)->next)
+	    ;
+
+	  gfc_code_walker (c, gfc_dummy_code_callback,
+			   replace_symbol_in_expr, (void *) &sr);
+
+	  for (ns_c = ns->contained; ns_c != NULL; ns_c = ns_c->sibling)
+	    {
+	      gfc_code **c_c;
+	      for (c_c = &ns_c->code; *c_c != NULL && (*c_c)->op == EXEC_INIT_ASSIGN;
+		   c_c = &(*c_c)->next)
+		;
+
+	      gfc_code_walker (&ns_c->code, gfc_dummy_code_callback,
+			       replace_symbol_in_expr, (void *) &sr);
+	    }
+
+	  if (sr.referenced)
+	    {
+	      gfc_code *n;
+	      gfc_symtree *formal_symtree;
+
+	      /* Generate statement __tmp_42_foo = foo .   */
+	      n = XCNEW (gfc_code);
+	      n->op = EXEC_ASSIGN;
+	      n->expr1 = gfc_lval_expr_from_sym (replacement);
+	      n->expr1->where = f->sym->declared_at;
+	      formal_symtree = gfc_find_symtree (ns->sym_root, f->sym->name);
+	      n->expr2 = gfc_get_variable_expr (formal_symtree);
+	      n->expr2->where = f->sym->declared_at;
+	      n->loc = f->sym->declared_at;
+
+	      n->next = (*c);
+	      (*c) = n;
+	    }
+	}
+    }
+}
Index: testsuite/gfortran.dg/pr26246_2.f90
===================================================================
--- testsuite/gfortran.dg/pr26246_2.f90	(Revision 278025)
+++ testsuite/gfortran.dg/pr26246_2.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! PR fortran/26246
-! { dg-options "-fdump-tree-original -fno-automatic" }
+! { dg-options "-fno-frontend-optimize -fdump-tree-original -fno-automatic" }
 ! { dg-do compile }
 
 subroutine foo(string, n)