re PR fortran/31154 (IMPORT fails for "<imported symbol> FUNCTION (...)" kind of procedures)

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31154
	PR fortran/31229
	PR fortran/33334
	* decl.c : Declare gfc_function_kind_locs and
	gfc_function_type_locus.
	(gfc_match_kind_spec): Add second argument kind_expr_only.
	Store locus before trying to match the expression. If the
	current state corresponds to a function declaration and there
	is no match to the expression, read to the parenthesis, return
	kind = -1, dump the expression and return.
	(gfc_match_type_spec): Renamed from match_type_spec and all
	references changed.  If an interface or an external function,
	store the locus, set kind = -1 and return.  Otherwise, if kind
	is already = -1, use gfc_find_symbol to try to find a use
	associated or imported type.
	match.h : Prototype for gfc_match_type_spec.
	* parse.c (match_deferred_characteristics): New function.
	(parse_spec): If in a function, statement is USE or IMPORT
	or DERIVED_DECL and the function kind=-1, call
	match_deferred_characteristics.  If kind=-1 at the end of the
	specification expressions, this is an error.
	* parse.h : Declare external gfc_function_kind_locs and
	gfc_function_type_locus.

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31154
	PR fortran/31229
	PR fortran/33334
	* gfortran.dg/function_kinds_1.f90: New test.
	* gfortran.dg/function_kinds_2.f90: New test.
	* gfortran.dg/derived_function_interface_1.f90: Correct illegal
	use association into interfaces.

From-SVN: r128948

1 files changed, 51 insertions, 0 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index a6672f4..86e486c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1866,6 +1866,35 @@ done:
 }
 
 
+/* Recover use associated or imported function characteristics.  */
+
+static try
+match_deferred_characteristics (gfc_typespec * ts)
+{
+  locus loc;
+  match m;
+
+  loc = gfc_current_locus;
+
+  if (gfc_current_block ()->ts.type != BT_UNKNOWN)
+    {
+      /* Kind expression for an intrinsic type.  */
+      gfc_current_locus = gfc_function_kind_locus;
+      m = gfc_match_kind_spec (ts, true);
+    }
+  else
+    {
+      /* A derived type.  */
+      gfc_current_locus = gfc_function_type_locus;
+      m = gfc_match_type_spec (ts, 0);
+    }
+
+  gfc_current_ns->proc_name->result->ts = *ts;
+  gfc_current_locus =loc;
+  return m;
+}
+
+
 /* Parse a set of specification statements.  Returns the statement
    that doesn't fit.  */
 
@@ -1951,6 +1980,15 @@ loop:
 	}
 
       accept_statement (st);
+
+      /* Look out for function kind/type information that used
+	 use associated or imported parameter.  This is signalled
+	 by kind = -1.  */
+      if (gfc_current_state () == COMP_FUNCTION
+	    && (st == ST_USE || st == ST_IMPORT || st == ST_DERIVED_DECL)
+	    && gfc_current_block ()->ts.kind == -1)
+	match_deferred_characteristics (&gfc_current_block ()->ts);
+
       st = next_statement ();
       goto loop;
 
@@ -1964,6 +2002,19 @@ loop:
       break;
     }
 
+  /* If we still have kind = -1 at the end of the specification block,
+     then there is an error. */
+  if (gfc_current_state () == COMP_FUNCTION
+	&& gfc_current_block ()->ts.kind == -1)
+    {
+      if (gfc_current_block ()->ts.type != BT_UNKNOWN)
+	gfc_error ("Bad kind expression for function '%s' at %L",
+		   gfc_current_block ()->name, &gfc_function_kind_locus);
+      else
+	gfc_error ("The type for function '%s' at %L is not accessible",
+		   gfc_current_block ()->name, &gfc_function_type_locus);
+    }
+
   return st;
 }