re PR fortran/32827 (IMPORT fails for TYPE when also used in INTERFACE)

2007-08-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32827
	* decl.c (variable_decl): Check for an imported symbol
	by looking for its symtree and testing for the imported
	attribute.
	(gfc_match_import): Remove change of symbol's namespace
	and set the attribute imported instead.
	* symbol.c (gfc_get_sym_tree): It is not an error if a
	symbol is imported.
	* gfortran.h : Add the 'imported' to symbol_attribute.

2007-08-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32827
	* gfortran.dg/import6.f90: New test.

From-SVN: r127397

gcc/fortran/ChangeLog

 2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/32827
+	* decl.c (variable_decl): Check for an imported symbol
+	by looking for its symtree and testing for the imported
+	attribute.
+	(gfc_match_import): Remove change of symbol's namespace
+	and set the attribute imported instead.
+	* symbol.c (gfc_get_sym_tree): It is not an error if a
+	symbol is imported.
+	* gfortran.h : Add the 'imported' to symbol_attribute.
+
+2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/32962
 	* trans-array.c (gfc_conv_array_transpose): Set the offset
 	of the destination to zero if the loop is zero based.

gcc/fortran/decl.c

@@ -1553,13 +1553,20 @@ variable_decl (int elem)
   if (current_ts.type == BT_DERIVED
       && gfc_current_ns->proc_name
       && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
-      && current_ts.derived->ns != gfc_current_ns
-      && !gfc_current_ns->has_import_set)
-    {
-      gfc_error ("the type of '%s' at %C has not been declared within the "
-		 "interface", name);
-      m = MATCH_ERROR;
-      goto cleanup;
+      && current_ts.derived->ns != gfc_current_ns)
+    {
+      gfc_symtree *st;
+      st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.derived->name);
+      if (!(current_ts.derived->attr.imported
+		&& st != NULL
+		&& st->n.sym == current_ts.derived)
+	    && !gfc_current_ns->has_import_set)
+	{
+	    gfc_error ("the type of '%s' at %C has not been declared within the "
+		       "interface", name);
+	    m = MATCH_ERROR;
+	    goto cleanup;
+	}
     }
 
   /* In functions that have a RESULT variable defined, the function
@@ -2433,7 +2440,7 @@ gfc_match_import (void)
 	  st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
 	  st->n.sym = sym;
 	  sym->refs++;
-	  sym->ns = gfc_current_ns;
+	  sym->attr.imported = 1;
 
 	  goto next_item;
 

gcc/fortran/gfortran.h

@@ -640,7 +640,8 @@ typedef struct
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
     protected:1,		/* Symbol has been marked as protected.  */
     use_assoc:1,		/* Symbol has been use-associated.  */
-    use_only:1;			/* Symbol has been use-associated, with ONLY.  */
+    use_only:1,			/* Symbol has been use-associated, with ONLY.  */
+    imported:1;			/* Symbol has been associated by IMPORT.  */
 
   unsigned in_namelist:1, in_common:1, in_equivalence:1;
   unsigned function:1, subroutine:1, generic:1, generic_copy:1;

gcc/fortran/symbol.c

@@ -2393,7 +2393,10 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result)
 
       p = st->n.sym;
 
-      if (p->ns != ns && (!p->attr.function || ns->proc_name != p))
+      if (p->ns != ns && (!p->attr.function || ns->proc_name != p)
+	    && !(ns->proc_name
+		   && ns->proc_name->attr.if_source == IFSRC_IFBODY
+		   && (ns->has_import_set || p->attr.imported)))
 	{
 	  /* Symbol is from another namespace.  */
 	  gfc_error ("Symbol '%s' at %C has already been host associated",

gcc/testsuite/ChangeLog

+2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32827
+	* gfortran.dg/import6.f90: New test.
+
 2007-08-13  Andrew Pinski  <pinskia@gmail.com>
 
 	PR C/30427

gcc/testsuite/gfortran.dg/import6.f90

+! { dg-do compile }
+! Tests the fix for PR32827, in which IMPORT :: my_type put the
+! symbol into the interface namespace, thereby generating an error
+! when the declaration of 'x' is compiled.
+!
+! Contributed by Douglas Wells <sysmaint@contek.com>
+!
+subroutine func1(param)
+  type :: my_type
+    integer :: data
+  end type my_type
+  type(my_type) :: param
+  param%data = 99
+end subroutine func1
+
+subroutine func2(param)
+  type :: my_type
+    integer :: data
+  end type my_type
+  type(my_type) :: param
+  param%data = 21
+end subroutine func2
+
+  type :: my_type
+    integer :: data
+  end type my_type
+
+  interface
+    subroutine func1(param)
+      import :: my_type
+      type(my_type) :: param
+    end subroutine func1
+  end interface
+  interface
+    subroutine func2(param)
+      import
+      type(my_type) :: param
+    end subroutine func2
+  end interface
+
+  type(my_type) :: x
+  call func1(x)
+  print *, x%data
+  call func2(x)
+  print *, x%data
+end