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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127397 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index faa76ef..26a0cd2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,17 @@
 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.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d674aeb..1bb82bc 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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;
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 704ff7e..0854594 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/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;

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 3aae04c..a1cd815 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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",

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ccf4aac..2235cff 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/import6.f90 b/gcc/testsuite/gfortran.dg/import6.f90
new file mode 100644 (file)
index 0000000..1bf9669
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/import6.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }\r
+! Tests the fix for PR32827, in which IMPORT :: my_type put the\r
+! symbol into the interface namespace, thereby generating an error\r
+! when the declaration of 'x' is compiled.\r
+!\r
+! Contributed by Douglas Wells <sysmaint@contek.com>\r
+!\r
+subroutine func1(param)\r
+  type :: my_type\r
+    integer :: data\r
+  end type my_type\r
+  type(my_type) :: param\r
+  param%data = 99\r
+end subroutine func1\r
+\r
+subroutine func2(param)\r
+  type :: my_type\r
+    integer :: data\r
+  end type my_type\r
+  type(my_type) :: param\r
+  param%data = 21\r
+end subroutine func2\r
+\r
+  type :: my_type\r
+    integer :: data\r
+  end type my_type\r
+\r
+  interface\r
+    subroutine func1(param)\r
+      import :: my_type\r
+      type(my_type) :: param\r
+    end subroutine func1\r
+  end interface\r
+  interface\r
+    subroutine func2(param)\r
+      import\r
+      type(my_type) :: param\r
+    end subroutine func2\r
+  end interface\r
+\r
+  type(my_type) :: x\r
+  call func1(x)\r
+  print *, x%data\r
+  call func2(x)\r
+  print *, x%data\r
+end\r