1 files changed, 59 insertions, 20 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 73f2c40a36c..ea766537a50 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2378,21 +2378,15 @@ check_init_expr (gfc_expr *e)
   return t;
 }
 
+/* Reduces a general expression to an initialization expression (a constant).
+   This used to be part of gfc_match_init_expr.
+   Note that this function doesn't free the given expression on FAILURE.  */
 
-/* Match an initialization expression.  We work by first matching an
-   expression, then reducing it to a constant.  */
-
-match
-gfc_match_init_expr (gfc_expr **result)
+gfc_try
+gfc_reduce_init_expr (gfc_expr *expr)
 {
-  gfc_expr *expr;
-  match m;
   gfc_try t;
 
-  m = gfc_match_expr (&expr);
-  if (m != MATCH_YES)
-    return m;
-
   gfc_init_expr = 1;
   t = gfc_resolve_expr (expr);
   if (t == SUCCESS)
@@ -2400,18 +2394,12 @@ gfc_match_init_expr (gfc_expr **result)
   gfc_init_expr = 0;
 
   if (t == FAILURE)
-    {
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-    }
+    return FAILURE;
 
   if (expr->expr_type == EXPR_ARRAY
       && (gfc_check_constructor_type (expr) == FAILURE
-	  || gfc_expand_constructor (expr) == FAILURE))
-    {
-      gfc_free_expr (expr);
-      return MATCH_ERROR;
-    }
+      || gfc_expand_constructor (expr) == FAILURE))
+    return FAILURE;
 
   /* Not all inquiry functions are simplified to constant expressions
      so it is necessary to call check_inquiry again.  */ 
@@ -2419,6 +2407,33 @@ gfc_match_init_expr (gfc_expr **result)
       && !gfc_in_match_data ())
     {
       gfc_error ("Initialization expression didn't reduce %C");
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match an initialization expression.  We work by first matching an
+   expression, then reducing it to a constant.  */
+
+match
+gfc_match_init_expr (gfc_expr **result)
+{
+  gfc_expr *expr;
+  match m;
+  gfc_try t;
+
+  expr = NULL;
+
+  m = gfc_match_expr (&expr);
+  if (m != MATCH_YES)
+    return m;
+
+  t = gfc_reduce_init_expr (expr);
+  if (t != SUCCESS)
+    {
+      gfc_free_expr (expr);
       return MATCH_ERROR;
     }
 
@@ -3487,3 +3502,27 @@ gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict)
 
   return error_found ? FAILURE : SUCCESS;
 }
+
+/* Walk an expression tree and replace all symbols with a corresponding symbol
+   in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE
+   statements. The boolean return value is required by gfc_traverse_expr.  */
+
+static bool
+replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED)
+{
+  if ((expr->expr_type == EXPR_VARIABLE || expr->expr_type == EXPR_FUNCTION)
+      && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns)
+    {
+      gfc_symtree *stree;
+      gfc_get_sym_tree (expr->symtree->name, sym->formal_ns, &stree);
+      stree->n.sym->attr = expr->symtree->n.sym->attr;
+      expr->symtree = stree;
+    }
+  return false;
+}
+
+void
+gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest)
+{
+  gfc_traverse_expr (expr, dest, &replace_symbol, 0);
+}