OSDN Git Service

2013-02-17 Tobias Burnus <burnus@net-b.de>
authormikael <mikael@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 17 Feb 2013 22:59:52 +0000 (22:59 +0000)
committermikael <mikael@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 17 Feb 2013 22:59:52 +0000 (22:59 +0000)
    Mikael Morin  <mikael@gcc.gnu.org>

Backport from trunk
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-02-17  Tobias Burnus  <burnus@net-b.de>
    Mikael Morin  <mikael@gcc.gnu.org>

Backport from trunk
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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@196112 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/decl.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/import10.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/import11.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/import2.f90
gcc/testsuite/gfortran.dg/import8.f90
gcc/testsuite/gfortran.dg/interface_derived_type_1.f90

index 49f272b..00adaf8 100644 (file)
@@ -1,3 +1,18 @@
+2013-02-17  Tobias Burnus  <burnus@net-b.de>
+           Mikael Morin  <mikael@gcc.gnu.org>
+
+       Backport from trunk
+       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-02-15  Tobias Burnus  <burnus@net-b.de>
            Mikael Morin  <mikael@gcc.gnu.org>
 
index dbcd2a0..3e9bc18 100644 (file)
@@ -1949,30 +1949,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;
@@ -3160,14 +3136,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;
@@ -3179,8 +3155,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;
@@ -4231,7 +4207,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.  */
index 0cd7cc8..dcf40d9 100644 (file)
@@ -2650,6 +2650,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);
@@ -2808,17 +2813,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);
index 42078c6..7f15f24 100644 (file)
@@ -1,3 +1,17 @@
+2013-02-17  Tobias Burnus  <burnus@net-b.de>
+           Mikael Morin  <mikael@gcc.gnu.org>
+
+       Backport from trunk
+       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-02-15  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/56318
diff --git a/gcc/testsuite/gfortran.dg/import10.f90 b/gcc/testsuite/gfortran.dg/import10.f90
new file mode 100644 (file)
index 0000000..dbe630a
--- /dev/null
@@ -0,0 +1,24 @@
+! { 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
+
+
diff --git a/gcc/testsuite/gfortran.dg/import11.f90 b/gcc/testsuite/gfortran.dg/import11.f90
new file mode 100644 (file)
index 0000000..f2ac514
--- /dev/null
@@ -0,0 +1,28 @@
+! { 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
+
+
index 4a0128a..0f380b7 100644 (file)
@@ -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
 
index 0d88e62..543b0a1 100644 (file)
@@ -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
index a2c4d02..710fcff 100644 (file)
@@ -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