[patch,fortran] Allow "IMPORT :: list-of-symbols" in interface bodys in modules (PR27546)

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

Now with a proper patch.


Tobias Burnus wrote on November 20, 2006:
> there are two kinds of imports possible:
>
> First, "IMPORT" which imports all symbols and is done by essentially by
> doing:
>    if( IS_INTERFACE && !current_namelist->has_import_set)
>   
(This works flawlessly in the trunk.)

> Secondly, "IMPORT :: list-of-symbols". I currently do in decl.c's
> gfc_match_import:
>
>    gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym)
>    st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
>    st->n.sym = sym;
>    sym->refs++;
>    sym->ns = gfc_current_ns;
>
> This works ok for programs, but fails for modules in trans-decl.c's
> gfc_create_module_variable:
>   /* Only output symbols from this module.  */
>   if (sym->ns != module_namespace)
>       /* I don't think this should ever happen.  */
>       internal_error ("module symbol %s in wrong namespace", sym->name);
>
> If I comment that condition, it seems to work without any problems, but
> I'm not sure I do the right thing(TM).
>   
The patch now exactly does so. Ok for the trunk? Or should this handled
differently?

Tobias

fortran/
2006-11-28  Tobias Burnus  <burnus@net-b.de>

    PR fortran/27546
    * trans-decl.f90 (gfc_create_module_variable): Allow imported symbols
      in interface bodys in modules.

testsuite/
2006-11-28  Tobias Burnus  <burnus@net-b.de>

    PR fortran/27546
    * gfortran.dg/import4.f90: New test for IMPORT in modules.

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 119292)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -2755,13 +2755,6 @@
   if (sym->attr.entry)
     return;
 
-  /* Only output symbols from this module.  */
-  if (sym->ns != module_namespace)
-    {
-      /* I don't think this should ever happen.  */
-      internal_error ("module symbol %s in wrong namespace", sym->name);
-    }
-
   /* Only output variables and array valued parameters.  */
   if (sym->attr.flavor != FL_VARIABLE
       && (sym->attr.flavor != FL_PARAMETER || sym->attr.dimension == 0))
Index: gcc/testsuite/gfortran.dg/import4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/import4.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/import4.f90	(Revision 0)
@@ -0,0 +1,98 @@
+! { dg-do run }
+! Test for import in modules
+! PR fortran/29601
+
+subroutine bar(r)
+  implicit none
+  integer(8) :: r
+  if(r /= 42) call abort()
+  r = 13
+end subroutine bar
+
+subroutine foo(a)
+  implicit none
+  type myT
+     sequence
+     character(len=3) :: c
+  end type myT
+  type(myT) :: a
+  if(a%c /= "xyz") call abort()
+  a%c = "abc"
+end subroutine
+
+subroutine new(a,b)
+  implicit none
+  type gType
+     sequence
+     integer(8) :: c
+  end type gType
+  real(8) :: a
+  type(gType) :: b
+  if(a /= 99.0 .or. b%c /= 11) call abort()
+  a = -123.0
+  b%c = -44
+end subroutine new
+
+module general
+  implicit none
+  integer,parameter :: ikind = 8
+  type gType
+     sequence
+     integer(ikind) :: c
+  end type gType
+end module general
+
+module modtest
+  use general
+  implicit none
+  type myT
+     sequence
+     character(len=3) :: c
+  end type myT
+  integer, parameter :: dp = 8
+  interface
+     subroutine bar(x)
+       import :: dp
+       integer(dp) :: x
+     end subroutine bar
+     subroutine foo(c)
+      import :: myT
+       type(myT) :: c
+     end subroutine foo
+     subroutine new(x,y)
+      import :: ikind,gType
+      real(ikind) :: x
+      type(gType) :: y
+     end subroutine new
+  end interface
+  contains
+  subroutine test
+    integer(dp) :: y
+    y = 42
+    call bar(y)
+    if(y /= 13) call abort()
+  end subroutine test
+  subroutine test2()
+    type(myT) :: z
+    z%c = "xyz"
+    call foo(z)
+    if(z%c /= "abc") call abort()
+  end subroutine test2
+end module modtest
+
+program all
+  use modtest
+  implicit none
+  call test()
+  call test2()
+  call test3()
+contains
+  subroutine test3()
+    real(ikind) :: r
+    type(gType) :: t
+    r   = 99.0
+    t%c = 11
+    call new(r,t)
+    if(r /= -123.0 .or. t%c /= -44) call abort()
+  end subroutine test3
+end program all