From 36f4d1449ca5c83321e28cdffaf0182373b1e8d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tobias=20Schl=C3=BCter?= Date: Wed, 3 Nov 2004 01:54:02 +0100 Subject: 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 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/module.c | 5 +++++ gcc/testsuite/ChangeLog | 7 +++++++ gcc/testsuite/gfortran.dg/generic_1.f90 | 19 +++++++++++++++++++ gcc/testsuite/gfortran.dg/generic_2.f90 | 20 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/generic_3.f90 | 30 ++++++++++++++++++++++++++++++ 6 files changed, 88 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/generic_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/generic_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/generic_3.f90 (limited to 'gcc') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2ce462b..da75178c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2004-11-03 Tobias Schlueter + + PR fortran/17535 + PR fortran/17583 + PR fortran/17713 + * module.c (write_symbol1): Set module_name for dummy arguments. + 2004-11-02 Paul Brook * intrinsic.c (check_intrinsic_standard): Include error locus. diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 5940053..ecc6df1 100644 --- 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 f1b49d1..4ccbd09 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2004-11-03 Tobias Schlueter + + PR fortran/17535 + PR fortran/17583 + PR fortran/17713 + * gfortran.dg/generic_[123].f90: New testcases. + 2004-11-02 Eric Botcazou * 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 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 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 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 -- cgit v1.1