re PR fortran/53537 (Explicit IMPORT of renamed USE-associated symbol fails)

2013-01-28  Tobias Burnus  <burnus@net-b.de>
	    Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/53537
	* symbol.c (gfc_find_sym_tree): Don't look for the symbol outside an
	interface block.
	(gfc_get_ha_symtree): Let gfc_find_sym_tree lookup the parent namespace.
	* decl.c (gfc_match_data_decl): Ditto.
	(variable_decl): Remove undeclared type error.
	(gfc_match_import): Use renamed instead of original name.

2013-01-28  Tobias Burnus  <burnus@net-b.de>
	    Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/53537
	* gfortran.dg/import2.f90: Adjust undeclared type error messages.
	* gfortran.dg/import8.f90: Likewise.
	* gfortran.dg/interface_derived_type_1.f90: Likewise.
	* gfortran.dg/import10.f90: New test.
	* gfortran.dg/import11.f90: Likewise


Co-Authored-By: Mikael Morin <mikael@gcc.gnu.org>

From-SVN: r195506

gcc/fortran/ChangeLog

+2013-01-28  Tobias Burnus  <burnus@net-b.de>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/53537
+	* symbol.c (gfc_find_sym_tree): Don't look for the symbol outside an
+	interface block.
+	(gfc_get_ha_symtree): Let gfc_find_sym_tree lookup the parent namespace.
+	* decl.c (gfc_match_data_decl): Ditto.
+	(variable_decl): Remove undeclared type error.
+	(gfc_match_import): Use renamed instead of original name.
+
 2013-01-27 Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/55984

gcc/fortran/decl.c

@@ -1979,30 +1979,6 @@ variable_decl (int elem)
       goto cleanup;
     }
 
-  /* An interface body specifies all of the procedure's
-     characteristics and these shall be consistent with those
-     specified in the procedure definition, except that the interface
-     may specify a procedure that is not pure if the procedure is
-     defined to be pure(12.3.2).  */
-  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
-      && gfc_current_ns->proc_name
-      && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
-      && current_ts.u.derived->ns != gfc_current_ns)
-    {
-      gfc_symtree *st;
-      st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.u.derived->name);
-      if (!(current_ts.u.derived->attr.imported
-		&& st != NULL
-		&& gfc_find_dt_in_generic (st->n.sym) == current_ts.u.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;
-	}
-    }
-
   if (check_function_name (name) == FAILURE)
     {
       m = MATCH_ERROR;
@@ -3240,14 +3216,14 @@ gfc_match_import (void)
 	      return MATCH_ERROR;
 	    }
 
-	  if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+	  if (gfc_find_symtree (gfc_current_ns->sym_root, name))
 	    {
 	      gfc_warning ("'%s' is already IMPORTed from host scoping unit "
 			   "at %C.", name);
 	      goto next_item;
 	    }
 
-	  st = gfc_new_symtree (&gfc_current_ns->sym_root, sym->name);
+	  st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
 	  st->n.sym = sym;
 	  sym->refs++;
 	  sym->attr.imported = 1;
@@ -3259,8 +3235,8 @@ gfc_match_import (void)
 		 lower-case name contains the associated generic function. */
 	      st = gfc_new_symtree (&gfc_current_ns->sym_root,
 			gfc_get_string ("%c%s",
-				(char) TOUPPER ((unsigned char) sym->name[0]),
-				&sym->name[1]));
+				(char) TOUPPER ((unsigned char) name[0]),
+				&name[1]));
 	      st->n.sym = sym;
 	      sym->refs++;
 	      sym->attr.imported = 1;
@@ -4315,7 +4291,7 @@ gfc_match_data_decl (void)
 	goto ok;
 
       gfc_find_symbol (current_ts.u.derived->name,
-		       current_ts.u.derived->ns->parent, 1, &sym);
+		       current_ts.u.derived->ns, 1, &sym);
 
       /* Any symbol that we find had better be a type definition
 	 which has its components defined.  */

gcc/fortran/symbol.c

@@ -2677,6 +2677,11 @@ gfc_find_sym_tree (const char *name, gfc_namespace *ns, int parent_flag,
       if (!parent_flag)
 	break;
 
+      /* Don't escape an interface block.  */
+      if (ns && !ns->has_import_set
+          && ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY)
+	break;
+
       ns = ns->parent;
     }
   while (ns != NULL);
@@ -2835,17 +2840,14 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
       return i;
     }
 
-  if (gfc_current_ns->parent != NULL)
-    {
-      i = gfc_find_sym_tree (name, gfc_current_ns->parent, 1, &st);
-      if (i)
-	return i;
+  i = gfc_find_sym_tree (name, gfc_current_ns, 1, &st);
+  if (i)
+    return i;
 
-      if (st != NULL)
-	{
-	  *result = st;
-	  return 0;
-	}
+  if (st != NULL)
+    {
+      *result = st;
+      return 0;
     }
 
   return gfc_get_sym_tree (name, gfc_current_ns, result, false);

gcc/testsuite/ChangeLog

+2013-01-28  Tobias Burnus  <burnus@net-b.de>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/53537
+	* gfortran.dg/import2.f90: Adjust undeclared type error messages.
+	* gfortran.dg/import8.f90: Likewise.
+	* gfortran.dg/interface_derived_type_1.f90: Likewise.
+	* gfortran.dg/import10.f90: New test.
+	* gfortran.dg/import11.f90: Likewise
+
 2013-01-28  Jakub Jelinek  <jakub@redhat.com>
 
 	PR testsuite/56053

gcc/testsuite/gfortran.dg/import10.f90

+! { dg-do compile }
+!
+! PR fortran/53537
+! The use of WP in the ODE_DERIVATIVE interface used to be rejected because
+! the symbol was imported under the original name DP.
+!
+! Original test case from Arjen Markus <arjen.markus@deltares.nl>
+
+module select_precision
+    integer, parameter :: dp = kind(1.0)
+end module select_precision
+
+module ode_types
+    use select_precision, only: wp => dp
+    implicit none
+    interface
+        subroutine ode_derivative(x)
+            import   :: wp
+            real(wp) :: x
+        end subroutine ode_derivative
+    end interface
+end module ode_types
+
+

gcc/testsuite/gfortran.dg/import11.f90

+! { dg-do compile }
+!
+! PR fortran/53537
+! The definition of T1 in the interface used to be rejected because T3
+! was imported under the original name T1.
+
+       MODULE MOD
+         TYPE T1
+           SEQUENCE
+           integer :: j
+         END TYPE t1
+       END
+       PROGRAM MAIN
+         USE MOD, T3 => T1
+         INTERFACE SUBR
+           SUBROUTINE SUBR1(X,y)
+             IMPORT :: T3
+             type t1
+!               sequence
+!               integer :: i
+             end type t1
+             TYPE(T3) X
+!             TYPE(T1) X
+           END SUBROUTINE
+         END INTERFACE SUBR
+       END PROGRAM MAIN
+
+

gcc/testsuite/gfortran.dg/import2.f90

@@ -37,7 +37,7 @@ module testmod
   interface
     subroutine other(x,y)
       import ! { dg-error "Fortran 2003: IMPORT statement" }
-      type(modType) :: y ! { dg-error "not been declared within the interface" }
+      type(modType) :: y ! { dg-error "is being used before it is defined" }
       real(kind)    :: x ! { dg-error "has not been declared" }
     end subroutine
   end interface
@@ -56,13 +56,13 @@ program foo
   interface
     subroutine bar(x,y)
       import ! { dg-error "Fortran 2003: IMPORT statement" }
-      type(myType) :: x ! { dg-error "not been declared within the interface" }
+      type(myType) :: x ! { dg-error "is being used before it is defined" }
       integer(dp)  :: y ! { dg-error "has not been declared" }
     end subroutine bar
     subroutine test(x)
       import :: myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
       import myType3 ! { dg-error "Fortran 2003: IMPORT statement" }
-      type(myType3) :: x ! { dg-error "not been declared within the interface" }
+      type(myType3) :: x ! { dg-error "is being used before it is defined" }
     end subroutine test
   end interface
 

gcc/testsuite/gfortran.dg/import8.f90

@@ -12,7 +12,7 @@ end type Connection
 abstract interface
     subroutine generic_desc(self)
         ! <<< missing IMPORT 
-        class(Connection) :: self ! { dg-error "has not been declared within the interface" }
+        class(Connection) :: self ! { dg-error "is being used before it is defined" }
     end subroutine generic_desc
 end interface
 end

gcc/testsuite/gfortran.dg/interface_derived_type_1.f90

@@ -13,7 +13,7 @@ contains
   subroutine sim_1(func1,params)
     interface
       function func1(fparams)
-        type(fcnparms) :: fparams ! { dg-error "not been declared within the interface" }
+        type(fcnparms) :: fparams ! { dg-error "is being used before it is defined" }
         real :: func1
       end function func1
     end interface