--- a/gcc/fortran/interface.c	Thu Oct 25 07:37:49 2018 +0900
+++ b/gcc/fortran/interface.c	Thu Feb 13 11:34:05 2020 +0900
@@ -1,5 +1,5 @@
 /* Deal with interfaces.
-   Copyright (C) 2000-2018 Free Software Foundation, Inc.
+   Copyright (C) 2000-2020 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -692,6 +692,16 @@
   if (ts1->type == BT_VOID || ts2->type == BT_VOID)
     return true;
 
+  /* Special case for our C interop types.  FIXME: There should be a
+     better way of doing this.  When ISO C binding is cleared up,
+     this can probably be removed.  See PR 57048.  */
+
+  if (((ts1->type == BT_INTEGER && ts2->type == BT_DERIVED)
+       || (ts1->type == BT_DERIVED && ts2->type == BT_INTEGER))
+      && ts1->u.derived && ts2->u.derived
+      && ts1->u.derived == ts2->u.derived)
+    return true;
+
   /* The _data component is not always present, therefore check for its
      presence before assuming, that its derived->attr is available.
      When the _data component is not present, then nevertheless the
@@ -1320,7 +1330,8 @@
 	  || !compare_type_characteristics (s2, s1))
 	{
 	  snprintf (errmsg, err_len, "Type mismatch in argument '%s' (%s/%s)",
-		    s1->name, gfc_typename (&s1->ts), gfc_typename (&s2->ts));
+		    s1->name, gfc_dummy_typename (&s1->ts),
+		    gfc_dummy_typename (&s2->ts));
 	  return false;
 	}
       if (!compare_rank (s1, s2))
@@ -1797,9 +1808,9 @@
 	    if (!compare_rank (f2->sym, f1->sym))
 	      {
 		if (errmsg != NULL)
-		  snprintf (errmsg, err_len, "Rank mismatch in argument '%s' "
-			    "(%i/%i)", f1->sym->name, symbol_rank (f1->sym),
-			    symbol_rank (f2->sym));
+		  snprintf (errmsg, err_len, "Rank mismatch in argument "
+			    "'%s' (%i/%i)", f1->sym->name,
+			    symbol_rank (f1->sym), symbol_rank (f2->sym));
 		return false;
 	      }
 	    if ((gfc_option.allow_std & GFC_STD_F2008)
@@ -2179,25 +2190,106 @@
 
 static void
 argument_rank_mismatch (const char *name, locus *where,
-			int rank1, int rank2)
+			int rank1, int rank2, locus *where_formal)
 {
 
   /* TS 29113, C407b.  */
-  if (rank2 == -1)
-    gfc_error ("The assumed-rank array at %L requires that the dummy argument"
-	       " %qs has assumed-rank", where, name);
-  else if (rank1 == 0)
-    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
-		   "at %L (scalar and rank-%d)", name, where, rank2);
-  else if (rank2 == 0)
-    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
-		   "at %L (rank-%d and scalar)", name, where, rank1);
+  if (where_formal == NULL)
+    {
+      if (rank2 == -1)
+	gfc_error ("The assumed-rank array at %L requires that the dummy "
+		   "argument %qs has assumed-rank", where, name);
+      else if (rank1 == 0)
+	gfc_error_opt (0, "Rank mismatch in argument %qs "
+		       "at %L (scalar and rank-%d)", name, where, rank2);
+      else if (rank2 == 0)
+	gfc_error_opt (0, "Rank mismatch in argument %qs "
+		       "at %L (rank-%d and scalar)", name, where, rank1);
+      else
+	gfc_error_opt (0, "Rank mismatch in argument %qs "
+		       "at %L (rank-%d and rank-%d)", name, where, rank1,
+		       rank2);
+    }
   else
-    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
-		   "at %L (rank-%d and rank-%d)", name, where, rank1, rank2);
+    {
+      gcc_assert (rank2 != -1);
+      if (rank1 == 0)
+	gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+		       "and actual argument at %L (scalar and rank-%d)",
+		       where, where_formal, rank2);
+      else if (rank2 == 0)
+	gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+		       "and actual argument at %L (rank-%d and scalar)",
+		       where, where_formal, rank1);
+      else
+	gfc_error_opt (0, "Rank mismatch between actual argument at %L "
+		       "and actual argument at %L (rank-%d and rank-%d", where,
+		       where_formal, rank1, rank2);
+    }
 }
 
 
+/* Under certain conditions, a scalar actual argument can be passed
+   to an array dummy argument - see F2018, 15.5.2.4, paragraph 14.
+   This function returns true for these conditions so that an error
+   or warning for this can be suppressed later.  Always return false
+   for expressions with rank > 0.  */
+
+bool
+maybe_dummy_array_arg (gfc_expr *e)
+{
+  gfc_symbol *s;
+  gfc_ref *ref;
+  bool array_pointer = false;
+  bool assumed_shape = false;
+  bool scalar_ref = true;
+
+  if (e->rank > 0)
+    return false;
+
+  if (e->ts.type == BT_CHARACTER && e->ts.kind == 1)
+    return true;
+
+  /* If this comes from a constructor, it has been an array element
+     originally.  */
+
+  if (e->expr_type == EXPR_CONSTANT)
+    return e->from_constructor;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  s = e->symtree->n.sym;
+
+  if (s->attr.dimension)
+    {
+      scalar_ref = false;
+      array_pointer = s->attr.pointer;
+    }
+
+  if (s->as && s->as->type == AS_ASSUMED_SHAPE)
+    assumed_shape = true;
+
+  for (ref=e->ref; ref; ref=ref->next)
+    {
+      if (ref->type == REF_COMPONENT)
+	{
+	  symbol_attribute *attr;
+	  attr = &ref->u.c.component->attr;
+	  if (attr->dimension)
+	    {
+	      array_pointer = attr->pointer;
+	      assumed_shape = false;
+	      scalar_ref = false;
+	    }
+	  else
+	    scalar_ref = true;
+	}
+    }
+
+  return !(scalar_ref || array_pointer || assumed_shape);
+}
+
 /* Given a symbol of a formal argument list and an expression, see if
    the two are compatible as arguments.  Returns true if
    compatible, false if not compatible.  */
@@ -2243,8 +2335,7 @@
 				   sizeof(err), NULL, NULL))
 	{
 	  if (where)
-	    gfc_error_opt (OPT_Wargument_mismatch,
-			   "Interface mismatch in dummy procedure %qs at %L:"
+	    gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
 			   " %s", formal->name, &actual->where, err);
 	  return false;
 	}
@@ -2271,8 +2362,7 @@
 				   err, sizeof(err), NULL, NULL))
 	{
 	  if (where)
-	    gfc_error_opt (OPT_Wargument_mismatch,
-			   "Interface mismatch in dummy procedure %qs at %L:"
+	    gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
 			   " %s", formal->name, &actual->where, err);
 	  return false;
 	}
@@ -2302,10 +2392,24 @@
 					 CLASS_DATA (actual)->ts.u.derived)))
     {
       if (where)
-	gfc_error_opt (OPT_Wargument_mismatch,
-		       "Type mismatch in argument %qs at %L; passed %s to %s",
-		       formal->name, where, gfc_typename (&actual->ts),
-		       gfc_typename (&formal->ts));
+	{
+	  if (formal->attr.artificial)
+	    {
+	      if (!flag_allow_argument_mismatch || !formal->error)
+		gfc_error_opt (0, "Type mismatch between actual argument at %L "
+			       "and actual argument at %L (%s/%s).",
+			       &actual->where,
+			       &formal->declared_at,
+			       gfc_typename (actual),
+			       gfc_dummy_typename (&formal->ts));
+
+	      formal->error = 1;
+	    }
+	  else
+	    gfc_error_opt (0, "Type mismatch in argument %qs at %L; passed %s "
+			   "to %s", formal->name, where, gfc_typename (actual),
+			   gfc_dummy_typename (&formal->ts));
+	}
       return false;
     }
 
@@ -2501,9 +2605,20 @@
       || (actual->rank == 0 && formal->attr.dimension
 	  && gfc_is_coindexed (actual)))
     {
-      if (where)
-	argument_rank_mismatch (formal->name, &actual->where,
-				symbol_rank (formal), actual->rank);
+      if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+					   && !maybe_dummy_array_arg (actual))))
+	{
+	  locus *where_formal;
+	  if (formal->attr.artificial)
+	    where_formal = &formal->declared_at;
+	  else
+	    where_formal = NULL;
+
+	  argument_rank_mismatch (formal->name, &actual->where,
+				  symbol_rank (formal), actual->rank,
+				  where_formal);
+	}
       return false;
     }
   else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
@@ -2542,9 +2657,17 @@
       && (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
     {
       if (where)
-	gfc_error ("Element of assumed-shaped or pointer "
-		   "array passed to array dummy argument %qs at %L",
-		   formal->name, &actual->where);
+	{
+	  if (formal->attr.artificial)
+	    gfc_error ("Element of assumed-shape or pointer array "
+		       "as actual argument at %L can not correspond to "
+		       "actual argument at %L ",
+		       &actual->where, &formal->declared_at);
+	  else
+	    gfc_error ("Element of assumed-shape or pointer "
+		       "array passed to array dummy argument %qs at %L",
+		       formal->name, &actual->where);
+	}
       return false;
     }
 
@@ -2573,9 +2696,20 @@
 
   if (ref == NULL && actual->expr_type != EXPR_NULL)
     {
-      if (where)
-	argument_rank_mismatch (formal->name, &actual->where,
-				symbol_rank (formal), actual->rank);
+      if (where 
+	  && (!formal->attr.artificial || (!formal->maybe_array
+					   && !maybe_dummy_array_arg (actual))))
+	{
+	  locus *where_formal;
+	  if (formal->attr.artificial)
+	    where_formal = &formal->declared_at;
+	  else
+	    where_formal = NULL;
+
+	  argument_rank_mismatch (formal->name, &actual->where,
+				  symbol_rank (formal), actual->rank,
+				  where_formal);
+	}
       return false;
     }
 
@@ -2868,10 +3002,10 @@
    errors when things don't match instead of just returning the status
    code.  */
 
-static bool
-compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
-	 	       int ranks_must_agree, int is_elemental,
-		       bool in_statement_function, locus *where)
+bool
+gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
+			   int ranks_must_agree, int is_elemental,
+			   bool in_statement_function, locus *where)
 {
   gfc_actual_arglist **new_arg, *a, *actual;
   gfc_formal_arglist *f;
@@ -2959,25 +3093,33 @@
 
       if (f->sym == NULL)
 	{
+	  /* These errors have to be issued, otherwise an ICE can occur.
+	     See PR 78865.  */
 	  if (where)
-	    gfc_error ("Missing alternate return spec in subroutine call "
-		       "at %L", where);
+	    gfc_error_now ("Missing alternate return specifier in subroutine "
+			   "call at %L", where);
 	  return false;
 	}
 
       if (a->expr == NULL)
 	{
-	  if (where)
-	    gfc_error ("Unexpected alternate return spec in subroutine "
-		       "call at %L", where);
-	  return false;
+	  if (f->sym->attr.optional)
+	    continue;
+	  else
+	    {
+	      if (where)
+		gfc_error_now ("Unexpected alternate return specifier in "
+			       "subroutine call at %L", where);
+	      return false;
+	    }
 	}
 
       /* Make sure that intrinsic vtables exist for calls to unlimited
 	 polymorphic formal arguments.  */
       if (UNLIMITED_POLY (f->sym)
 	  && a->expr->ts.type != BT_DERIVED
-	  && a->expr->ts.type != BT_CLASS)
+	  && a->expr->ts.type != BT_CLASS
+	  && a->expr->ts.type != BT_ASSUMED)
 	gfc_find_vtab (&a->expr->ts);
 
       if (a->expr->expr_type == EXPR_NULL
@@ -3044,16 +3186,14 @@
 		       f->sym->ts.u.cl->length->value.integer) != 0))
 	{
 	  if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
-	    gfc_warning (OPT_Wargument_mismatch,
-			 "Character length mismatch (%ld/%ld) between actual "
+	    gfc_warning (0, "Character length mismatch (%ld/%ld) between actual "
 			 "argument and pointer or allocatable dummy argument "
 			 "%qs at %L",
 			 mpz_get_si (a->expr->ts.u.cl->length->value.integer),
 			 mpz_get_si (f->sym->ts.u.cl->length->value.integer),
 			 f->sym->name, &a->expr->where);
 	  else if (where)
-	    gfc_warning (OPT_Wargument_mismatch,
-			 "Character length mismatch (%ld/%ld) between actual "
+	    gfc_warning (0, "Character length mismatch (%ld/%ld) between actual "
 			 "argument and assumed-shape dummy argument %qs "
 			 "at %L",
 			 mpz_get_si (a->expr->ts.u.cl->length->value.integer),
@@ -3084,8 +3224,7 @@
 	  && f->sym->attr.flavor != FL_PROCEDURE)
 	{
 	  if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
-	    gfc_warning (OPT_Wargument_mismatch,
-			 "Character length of actual argument shorter "
+	    gfc_warning (0, "Character length of actual argument shorter "
 			 "than of dummy argument %qs (%lu/%lu) at %L",
 			 f->sym->name, actual_size, formal_size,
 			 &a->expr->where);
@@ -3093,8 +3232,7 @@
 	    {
 	      /* Emit a warning for -std=legacy and an error otherwise. */
 	      if (gfc_option.warn_std == 0)
-	        gfc_warning (OPT_Wargument_mismatch,
-			     "Actual argument contains too few "
+	        gfc_warning (0, "Actual argument contains too few "
 			     "elements for dummy argument %qs (%lu/%lu) "
 			     "at %L", f->sym->name, actual_size,
 			     formal_size, &a->expr->where);
@@ -3476,6 +3614,13 @@
 	case REF_SUBSTRING:
 	  return false;
 
+	case REF_INQUIRY:
+	  if (e1->symtree->n.sym->ts.type == BT_COMPLEX
+	      && e1->ts.type == BT_REAL && e2->ts.type == BT_REAL
+	      && r1->u.i != r2->u.i)
+	    return false;
+	  break;
+
 	default:
 	  gfc_internal_error ("compare_actual_expr(): Bad component code");
 	}
@@ -3645,6 +3790,7 @@
 {
   gfc_actual_arglist *a;
   gfc_formal_arglist *dummy_args;
+  bool implicit = false;
 
   /* Warn about calls with an implicit interface.  Special case
      for calling a ISO_C_BINDING because c_loc and c_funloc
@@ -3652,7 +3798,16 @@
      explicitly declared at all if requested.  */
   if (sym->attr.if_source == IFSRC_UNKNOWN && !sym->attr.is_iso_c)
     {
-      if (sym->ns->has_implicit_none_export && sym->attr.proc == PROC_UNKNOWN)
+      bool has_implicit_none_export = false;
+      implicit = true;
+      if (sym->attr.proc == PROC_UNKNOWN)
+	for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent)
+	  if (ns->has_implicit_none_export)
+	    {
+	      has_implicit_none_export = true;
+	      break;
+	    }
+      if (has_implicit_none_export)
 	{
 	  const char *guessed
 	    = gfc_lookup_function_fuzzy (sym->name, sym->ns->sym_root);
@@ -3673,6 +3828,7 @@
 	gfc_warning (OPT_Wimplicit_procedure,
 		     "Procedure %qs called at %L is not explicitly declared",
 		     sym->name, where);
+      gfc_find_proc_namespace (sym->ns)->implicit_interface_calls = 1;
     }
 
   if (sym->attr.if_source == IFSRC_UNKNOWN)
@@ -3702,6 +3858,22 @@
 
       for (a = *ap; a; a = a->next)
 	{
+	  if (a->expr && a->expr->error)
+	    return false;
+
+	  /* F2018, 15.4.2.2 Explicit interface is required for a
+	     polymorphic dummy argument, so there is no way to
+	     legally have a class appear in an argument with an
+	     implicit interface.  */
+
+	  if (implicit && a->expr && a->expr->ts.type == BT_CLASS)
+	    {
+	      gfc_error ("Explicit interface required for polymorphic "
+			 "argument at %L",&a->expr->where);
+	      a->expr->error = 1;
+	      break;
+	    }
+
 	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
 	  if (a->name != NULL && a->name[0] != '%')
 	    {
@@ -3717,12 +3889,14 @@
 	      gfc_error ("Assumed-type argument %s at %L requires an explicit "
 			 "interface", a->expr->symtree->n.sym->name,
 			 &a->expr->where);
+	      a->expr->error = 1;
 	      break;
 	    }
 
 	  /* F2008, C1303 and C1304.  */
 	  if (a->expr
 	      && (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS)
+	      && a->expr->ts.u.derived
 	      && ((a->expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 		   && a->expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
 		  || gfc_expr_attr (a->expr).lock_comp))
@@ -3730,11 +3904,13 @@
 	      gfc_error ("Actual argument of LOCK_TYPE or with LOCK_TYPE "
 			 "component at %L requires an explicit interface for "
 			 "procedure %qs", &a->expr->where, sym->name);
+	      a->expr->error = 1;
 	      break;
 	    }
 
 	  if (a->expr
 	      && (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS)
+	      && a->expr->ts.u.derived
 	      && ((a->expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 		   && a->expr->ts.u.derived->intmod_sym_id
 		      == ISOFORTRAN_EVENT_TYPE)
@@ -3743,13 +3919,16 @@
 	      gfc_error ("Actual argument of EVENT_TYPE or with EVENT_TYPE "
 			 "component at %L requires an explicit interface for "
 			 "procedure %qs", &a->expr->where, sym->name);
+	      a->expr->error = 1;
 	      break;
 	    }
 
 	  if (a->expr && a->expr->expr_type == EXPR_NULL
 	      && a->expr->ts.type == BT_UNKNOWN)
 	    {
-	      gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
+	      gfc_error ("MOLD argument to NULL required at %L",
+			 &a->expr->where);
+	      a->expr->error = 1;
 	      return false;
 	    }
 
@@ -3759,6 +3938,7 @@
 	    {
 	      gfc_error ("Assumed-rank argument requires an explicit interface "
 			 "at %L", &a->expr->where);
+	      a->expr->error = 1;
 	      return false;
 	    }
 	}
@@ -3770,8 +3950,8 @@
 
   /* For a statement function, check that types and type parameters of actual
      arguments and dummy arguments match.  */
-  if (!compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental,
-			      sym->attr.proc == PROC_ST_FUNCTION, where))
+  if (!gfc_compare_actual_formal (ap, dummy_args, 0, sym->attr.elemental,
+				  sym->attr.proc == PROC_ST_FUNCTION, where))
     return false;
  
   if (!check_intents (dummy_args, *ap))
@@ -3819,7 +3999,7 @@
       return;
     }
 
-  if (!compare_actual_formal (ap, comp->ts.interface->formal, 0,
+  if (!gfc_compare_actual_formal (ap, comp->ts.interface->formal, 0,
 			      comp->attr.elemental, false, where))
     return;
 
@@ -3845,7 +4025,7 @@
   dummy_args = gfc_sym_get_dummy_args (sym);
 
   r = !sym->attr.elemental;
-  if (compare_actual_formal (args, dummy_args, r, !r, false, NULL))
+  if (gfc_compare_actual_formal (args, dummy_args, r, !r, false, NULL))
     {
       check_intents (dummy_args, *args);
       if (warn_aliasing)
@@ -4260,6 +4440,12 @@
   lhs = c->expr1;
   rhs = c->expr2;
 
+  /* Don't allow an intrinsic assignment with a BOZ rhs to be replaced.  */
+  if (c->op == EXEC_ASSIGN
+      && c->expr1->expr_type == EXPR_VARIABLE
+      && c->expr2->expr_type == EXPR_CONSTANT && c->expr2->ts.type == BT_BOZ)
+    return false;
+
   /* Don't allow an intrinsic assignment to be replaced.  */
   if (lhs->ts.type != BT_DERIVED && lhs->ts.type != BT_CLASS
       && (rhs->rank == 0 || rhs->rank == lhs->rank)
@@ -4542,7 +4728,7 @@
   /* If the overwritten procedure is GENERIC, this is an error.  */
   if (old->n.tb->is_generic)
     {
-      gfc_error ("Can't overwrite GENERIC %qs at %L",
+      gfc_error ("Cannot overwrite GENERIC %qs at %L",
 		 old->name, &proc->n.tb->where);
       return false;
     }
@@ -4665,8 +4851,7 @@
       if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym,
 					check_type, err, sizeof(err)))
 	{
-	  gfc_error_opt (OPT_Wargument_mismatch,
-			 "Argument mismatch for the overriding procedure "
+	  gfc_error_opt (0, "Argument mismatch for the overriding procedure "
 			 "%qs at %L: %s", proc->name, &where, err);
 	  return false;
 	}
@@ -5090,3 +5275,68 @@
 
   return dtio_sub;
 }
+
+/* Helper function - if we do not find an interface for a procedure,
+   construct it from the actual arglist.  Luckily, this can only
+   happen for call by reference, so the information we actually need
+   to provide (and which would be impossible to guess from the call
+   itself) is not actually needed.  */
+
+void
+gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
+				    gfc_actual_arglist *actual_args)
+{
+  gfc_actual_arglist *a;
+  gfc_formal_arglist **f;
+  gfc_symbol *s;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int var_num;
+
+  f = &sym->formal;
+  for (a = actual_args; a != NULL; a = a->next)
+    {
+      (*f) = gfc_get_formal_arglist ();
+      if (a->expr)
+	{
+	  snprintf (name, GFC_MAX_SYMBOL_LEN, "_formal_%d", var_num ++);
+	  gfc_get_symbol (name, gfc_current_ns, &s);
+	  if (a->expr->ts.type == BT_PROCEDURE)
+	    {
+	      s->attr.flavor = FL_PROCEDURE;
+	    }
+	  else
+	    {
+	      s->ts = a->expr->ts;
+
+	      if (s->ts.type == BT_CHARACTER)
+		s->ts.u.cl = gfc_get_charlen ();
+
+	      s->ts.deferred = 0;
+	      s->ts.is_iso_c = 0;
+	      s->ts.is_c_interop = 0;
+	      s->attr.flavor = FL_VARIABLE;
+	      s->attr.artificial = 1;
+	      if (a->expr->rank > 0)
+		{
+		  s->attr.dimension = 1;
+		  s->as = gfc_get_array_spec ();
+		  s->as->rank = 1;
+		  s->as->lower[0] = gfc_get_int_expr (gfc_index_integer_kind,
+						      &a->expr->where, 1);
+		  s->as->upper[0] = NULL;
+		  s->as->type = AS_ASSUMED_SIZE;
+		}
+	      else
+		s->maybe_array = maybe_dummy_array_arg (a->expr);
+	    }
+	  s->attr.dummy = 1;
+	  s->declared_at = a->expr->where;
+	  s->attr.intent = INTENT_UNKNOWN;
+	  (*f)->sym = s;
+	}
+      else  /* If a->expr is NULL, this is an alternate rerturn.  */
+	(*f)->sym = NULL;
+
+      f = &((*f)->next);
+    }
+}