re PR fortran/17535 (gfortran with module procedures)

fortran/
PR fortran/17535
PR fortran/17583
PR fortran/17713
* module.c (write_symbol1): Set module_name for dummy arguments.

testsuite/
PR fortran/17535
PR fortran/17583
PR fortran/17713
* gfortran.dg/generic_[123].f90: New testcases.

From-SVN: r90011

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2ce462b08d017422b19470fc8c186e7a1a070a68..da75178cc296a4fb46a52310e63fcb7464f7da20 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2004-11-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/17535
+       PR fortran/17583
+       PR fortran/17713
+       * module.c (write_symbol1): Set module_name for dummy arguments.
+
 2004-11-02  Paul Brook  <paul@codesourcery.com>
 
        * intrinsic.c (check_intrinsic_standard): Include error locus.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5940053897087bae35297bc78d0ac7ffcc76e5a2..ecc6df18ac7091b9ff8c662c0f86f4b70e76054c 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3269,6 +3269,11 @@ write_symbol1 (pointer_info * p)
   if (p->type != P_SYMBOL || p->u.wsym.state != NEEDS_WRITE)
     return 0;
 
+  /* FIXME: This shouldn't be necessary, but it works around
+     deficiencies in the module loader or/and symbol handling.  */
+  if (p->u.wsym.sym->module[0] == '\0' && p->u.wsym.sym->attr.dummy)
+    strcpy (p->u.wsym.sym->module, module_name);
+
   p->u.wsym.state = WRITTEN;
   write_symbol (p->integer, p->u.wsym.sym);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f1b49d1352f3c2a706817de4d8791574f136a255..4ccbd0903f29cdcc759a21eaf790f4cf8e007717 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2004-11-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/17535
+       PR fortran/17583
+       PR fortran/17713
+       * gfortran.dg/generic_[123].f90: New testcases.
+
 2004-11-02  Eric Botcazou  <ebotcazou@libertysurf.fr>
 
        * gcc.dg/uninit-C.c: Remove special-casing for SPARC.

diff --git a/gcc/testsuite/gfortran.dg/generic_1.f90 b/gcc/testsuite/gfortran.dg/generic_1.f90
new file mode 100644 (file)
index 0000000..1cbf4bb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! reduced testcase from PR 17535
+module FOO
+  interface BAR
+
+    subroutine BAR1(X)
+      integer :: X
+    end subroutine
+
+    subroutine BAR2(X)
+      real :: X
+    end subroutine
+
+  end interface
+end module
+
+subroutine BAZ(X)
+  use FOO
+end subroutine

diff --git a/gcc/testsuite/gfortran.dg/generic_2.f90 b/gcc/testsuite/gfortran.dg/generic_2.f90
new file mode 100644 (file)
index 0000000..802e966
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! testcase from PR 17583
+module bidon 
+ 
+ interface 
+  subroutine drivexc(nspden,rho_updn) 
+   integer,  intent(in) :: nspden 
+   integer, intent(in) :: rho_updn(nspden) 
+  end subroutine drivexc 
+ end interface 
+ 
+end module bidon 
+ 
+ subroutine nonlinear(nspden) 
+ 
+ use bidon 
+  
+ integer,intent(in) :: nspden 
+ 
+ end subroutine nonlinear

diff --git a/gcc/testsuite/gfortran.dg/generic_3.f90 b/gcc/testsuite/gfortran.dg/generic_3.f90
new file mode 100644 (file)
index 0000000..3cd2e9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_3.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! Testcase from PR 17713
+module fit_functions
+  implicit none
+contains
+  subroutine gauss( x, a, y, dy, ma )
+    double precision, intent(in)     :: x
+    double precision, intent(in)     :: a(:)
+    double precision, intent(out)    :: y
+    double precision, intent(out)    :: dy(:)
+    integer,          intent(in)     :: ma
+  end subroutine gauss
+end module fit_functions
+
+subroutine mrqcof( x, y, sig, ndata, a, ia, ma )
+  use fit_functions
+  
+  implicit none
+  double precision, intent(in)   :: x(:), y(:), sig(:)
+  integer,   intent(in)          :: ndata
+  double precision, intent(in)   :: a(:)
+  integer,   intent(in)          :: ia(:), ma
+  
+  integer                           i
+  double precision                  yan, dyda(ma)
+  
+  do i = 1, ndata
+     call gauss( x(i), a, yan, dyda, ma )
+  end do
+end subroutine mrqcof