re PR other/29975 ([meta-bugs] ICEs with CP2K)
2006-12-09 Paul Thomas <pault@gcc.gnu.org> PR fortran/29975 PR fortran/30068 PR fortran/30096 * interface.c (compare_type_rank_if): Reject invalid generic interfaces. (check_interface1): Give a warning for nonreferred to ambiguous interfaces. (check_sym_interfaces): Check whether an ambiguous interface is referred to. Do not check host associated interfaces since these cannot be ambiguous with the local versions. (check_uop_interface, gfc_check_interfaces): Update call to check_interface1. * symbol.c (gfc_get_sym_tree, gfc_get_sym_tree): Allow adding unambiguous procedures to generic interfaces. * gfortran.h (symbol_attribute): Added use_only and ambiguous_interfaces. * module.c (load_need): Set the use_only flag, if needed. * resolve.c (resolve_fl_procedure): Warn for nonreferred interfaces. * expr.c (find_array_section): Fix initializer array contructor. 2006-12-09 Paul Thomas <pault@gcc.gnu.org> Tobias Burnus <burnus@gcc.gnu.org> PR fortran/29975 PR fortran/30068 * gfortran.dg/interface_4.f90: Test adding procedure to generic interface. * gfortran.dg/interface_5.f90: Test warning for not-referenced-to ambiguous interfaces. * gfortran.dg/interface_6.f90: Test invalid, ambiguous interface. * gfortran.dg/interface_7.f90: Test invalid, ambiguous interface. * gfortran.dg/interface_8.f90: Test warning for not-referenced-to ambiguous interfaces. * gfortran.dg/interface_1.f90: Change dg-error into a dg-warning. * gfortran.dg/array_initializer_2.f90: Add initializer array constructor test. PR fortran/30096 * gfortran.dg/interface_9.f90: Test that host interfaces are not checked for ambiguity with the local version. Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org> From-SVN: r119697
This commit is contained in:
Paul Thomas
parent
1027275d2e
commit
993ef28f82
17 changed files with 342 additions and 25 deletions
|
|
@ -1,3 +1,26 @@
|
|||
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/29975
|
||||
PR fortran/30068
|
||||
PR fortran/30096
|
||||
* interface.c (compare_type_rank_if): Reject invalid generic
|
||||
interfaces.
|
||||
(check_interface1): Give a warning for nonreferred to ambiguous
|
||||
interfaces.
|
||||
(check_sym_interfaces): Check whether an ambiguous interface is
|
||||
referred to. Do not check host associated interfaces since these
|
||||
cannot be ambiguous with the local versions.
|
||||
(check_uop_interface, gfc_check_interfaces): Update call to
|
||||
check_interface1.
|
||||
* symbol.c (gfc_get_sym_tree, gfc_get_sym_tree): Allow adding
|
||||
unambiguous procedures to generic interfaces.
|
||||
* gfortran.h (symbol_attribute): Added use_only and
|
||||
ambiguous_interfaces.
|
||||
* module.c (load_need): Set the use_only flag, if needed.
|
||||
* resolve.c (resolve_fl_procedure): Warn for nonreferred
|
||||
interfaces.
|
||||
* expr.c (find_array_section): Fix initializer array contructor.
|
||||
|
||||
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/29464
|
||||
|
|
|
|||
|
|
@ -1189,7 +1189,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
|
|||
for (d = 0; d < rank; d++)
|
||||
{
|
||||
mpz_set (tmp_mpz, ctr[d]);
|
||||
mpz_sub_ui (tmp_mpz, tmp_mpz, one);
|
||||
mpz_sub (tmp_mpz, tmp_mpz,
|
||||
ref->u.ar.as->lower[d]->value.integer);
|
||||
mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
|
||||
mpz_add (ptr, ptr, tmp_mpz);
|
||||
|
||||
|
|
|
|||
|
|
@ -483,7 +483,8 @@ typedef struct
|
|||
dummy:1, result:1, assign:1, threadprivate:1;
|
||||
|
||||
unsigned data:1, /* Symbol is named in a DATA statement. */
|
||||
use_assoc:1; /* Symbol has been use-associated. */
|
||||
use_assoc:1, /* Symbol has been use-associated. */
|
||||
use_only:1; /* Symbol has been use-associated, with ONLY. */
|
||||
|
||||
unsigned in_namelist:1, in_common:1, in_equivalence:1;
|
||||
unsigned function:1, subroutine:1, generic:1, generic_copy:1;
|
||||
|
|
@ -518,6 +519,9 @@ typedef struct
|
|||
modification of type or type parameters is permitted. */
|
||||
unsigned referenced:1;
|
||||
|
||||
/* Set if the symbol has ambiguous interfaces. */
|
||||
unsigned ambiguous_interfaces:1;
|
||||
|
||||
/* Set if the is the symbol for the main program. This is the least
|
||||
cumbersome way to communicate this function property without
|
||||
strcmp'ing with __MAIN everywhere. */
|
||||
|
|
|
|||
|
|
@ -462,7 +462,9 @@ compare_type_rank_if (gfc_symbol * s1, gfc_symbol * s2)
|
|||
if (s1->attr.function && compare_type_rank (s1, s2) == 0)
|
||||
return 0;
|
||||
|
||||
return compare_interfaces (s1, s2, 0); /* Recurse! */
|
||||
/* Originally, gfortran recursed here to check the interfaces of passed
|
||||
procedures. This is explicitly not required by the standard. */
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -965,7 +967,8 @@ check_interface0 (gfc_interface * p, const char *interface_name)
|
|||
|
||||
static int
|
||||
check_interface1 (gfc_interface * p, gfc_interface * q0,
|
||||
int generic_flag, const char *interface_name)
|
||||
int generic_flag, const char *interface_name,
|
||||
int referenced)
|
||||
{
|
||||
gfc_interface * q;
|
||||
for (; p; p = p->next)
|
||||
|
|
@ -979,12 +982,20 @@ check_interface1 (gfc_interface * p, gfc_interface * q0,
|
|||
|
||||
if (compare_interfaces (p->sym, q->sym, generic_flag))
|
||||
{
|
||||
gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
|
||||
p->sym->name, q->sym->name, interface_name, &p->where);
|
||||
if (referenced)
|
||||
{
|
||||
gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
|
||||
p->sym->name, q->sym->name, interface_name,
|
||||
&p->where);
|
||||
}
|
||||
|
||||
if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
|
||||
gfc_warning ("Ambiguous interfaces '%s' and '%s' in %s at %L",
|
||||
p->sym->name, q->sym->name, interface_name,
|
||||
&p->where);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -997,7 +1008,7 @@ static void
|
|||
check_sym_interfaces (gfc_symbol * sym)
|
||||
{
|
||||
char interface_name[100];
|
||||
gfc_symbol *s2;
|
||||
int k;
|
||||
|
||||
if (sym->ns != gfc_current_ns)
|
||||
return;
|
||||
|
|
@ -1008,17 +1019,13 @@ check_sym_interfaces (gfc_symbol * sym)
|
|||
if (check_interface0 (sym->generic, interface_name))
|
||||
return;
|
||||
|
||||
s2 = sym;
|
||||
while (s2 != NULL)
|
||||
{
|
||||
if (check_interface1 (sym->generic, s2->generic, 1, interface_name))
|
||||
return;
|
||||
|
||||
if (s2->ns->parent == NULL)
|
||||
break;
|
||||
if (gfc_find_symbol (sym->name, s2->ns->parent, 1, &s2))
|
||||
break;
|
||||
}
|
||||
/* Originally, this test was aplied to host interfaces too;
|
||||
this is incorrect since host associated symbols, from any
|
||||
source, cannot be ambiguous with local symbols. */
|
||||
k = sym->attr.referenced || !sym->attr.use_assoc;
|
||||
if (check_interface1 (sym->generic, sym->generic, 1,
|
||||
interface_name, k))
|
||||
sym->attr.ambiguous_interfaces = 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1040,7 +1047,8 @@ check_uop_interfaces (gfc_user_op * uop)
|
|||
if (uop2 == NULL)
|
||||
continue;
|
||||
|
||||
check_interface1 (uop->operator, uop2->operator, 0, interface_name);
|
||||
check_interface1 (uop->operator, uop2->operator, 0,
|
||||
interface_name, 1);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1082,7 +1090,7 @@ gfc_check_interfaces (gfc_namespace * ns)
|
|||
|
||||
for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
|
||||
if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
|
||||
interface_name))
|
||||
interface_name, 1))
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -3228,6 +3228,8 @@ load_needed (pointer_info * p)
|
|||
|
||||
mio_symbol (sym);
|
||||
sym->attr.use_assoc = 1;
|
||||
if (only_flag)
|
||||
sym->attr.use_only = 1;
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -5528,6 +5528,10 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
|
|||
gfc_formal_arglist *arg;
|
||||
gfc_symtree *st;
|
||||
|
||||
if (sym->attr.ambiguous_interfaces && !sym->attr.referenced)
|
||||
gfc_warning ("Although not referenced, '%s' at %L has ambiguous "
|
||||
"interfaces", sym->name, &sym->declared_at);
|
||||
|
||||
if (sym->attr.function
|
||||
&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
|
||||
return FAILURE;
|
||||
|
|
|
|||
|
|
@ -2037,7 +2037,9 @@ gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag,
|
|||
if (st != NULL)
|
||||
{
|
||||
*result = st;
|
||||
if (st->ambiguous)
|
||||
/* Ambiguous generic interfaces are permitted, as long
|
||||
as the specific interfaces are different. */
|
||||
if (st->ambiguous && !st->n.sym->attr.generic)
|
||||
{
|
||||
ambiguous_symbol (name, st);
|
||||
return 1;
|
||||
|
|
@ -2138,8 +2140,10 @@ gfc_get_sym_tree (const char *name, gfc_namespace * ns, gfc_symtree ** result)
|
|||
}
|
||||
else
|
||||
{
|
||||
/* Make sure the existing symbol is OK. */
|
||||
if (st->ambiguous)
|
||||
/* Make sure the existing symbol is OK. Ambiguous
|
||||
generic interfaces are permitted, as long as the
|
||||
specific interfaces are different. */
|
||||
if (st->ambiguous && !st->n.sym->attr.generic)
|
||||
{
|
||||
ambiguous_symbol (name, st);
|
||||
return 1;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,24 @@
|
|||
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
Tobias Burnus <burnus@gcc.gnu.org>
|
||||
|
||||
PR fortran/29975
|
||||
PR fortran/30068
|
||||
* gfortran.dg/interface_4.f90: Test adding procedure to generic
|
||||
interface.
|
||||
* gfortran.dg/interface_5.f90: Test warning for not-referenced-to
|
||||
ambiguous interfaces.
|
||||
* gfortran.dg/interface_6.f90: Test invalid, ambiguous interface.
|
||||
* gfortran.dg/interface_7.f90: Test invalid, ambiguous interface.
|
||||
* gfortran.dg/interface_8.f90: Test warning for not-referenced-to
|
||||
ambiguous interfaces.
|
||||
* gfortran.dg/interface_1.f90: Change dg-error into a dg-warning.
|
||||
* gfortran.dg/array_initializer_2.f90: Add initializer array
|
||||
constructor test.
|
||||
|
||||
PR fortran/30096
|
||||
* gfortran.dg/interface_9.f90: Test that host interfaces are
|
||||
not checked for ambiguity with the local version.
|
||||
|
||||
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/29464
|
||||
|
|
|
|||
|
|
@ -2,6 +2,10 @@
|
|||
! Tests the fix for PR28496 in which initializer array constructors with
|
||||
! a missing initial array index would cause an ICE.
|
||||
!
|
||||
! Test for the fix of the initializer array constructor part of PR29975
|
||||
! was added later. Here, the indexing would get in a mess if the array
|
||||
! specification had a lower bound other than unity.
|
||||
!
|
||||
! Contributed by Paul Thomas <pault@gcc.gnu.org>
|
||||
! Based on original test case from Samir Nordin <snordin_ng@yahoo.fr>
|
||||
!
|
||||
|
|
@ -11,7 +15,17 @@
|
|||
integer, dimension(2,3), parameter :: d=reshape ((/c(3:2:-1,:)/),(/2,3/))
|
||||
integer, dimension(3,3), parameter :: e=reshape ((/a(:),a(:)+3,a(:)+6/),(/3,3/))
|
||||
integer, dimension(2,3), parameter :: f=reshape ((/c(2:1:-1,:)/),(/2,3/))
|
||||
CHARACTER (LEN=1), DIMENSION(3:7), PARAMETER :: g = &
|
||||
(/ '+', '-', '*', '/', '^' /)
|
||||
CHARACTER (LEN=3) :: h = "A+C"
|
||||
!
|
||||
! PR28496
|
||||
!
|
||||
if (any (b .ne. (/1,2,3/))) call abort ()
|
||||
if (any (reshape(d,(/6/)) .ne. (/3, 2, 6, 5, 9, 8/))) call abort ()
|
||||
if (any (reshape(f,(/6/)) .ne. (/2, 1, 5, 4, 8, 7/))) call abort ()
|
||||
!
|
||||
! PR29975
|
||||
!
|
||||
IF (all(h(2:2) /= g(3:4))) call abort ()
|
||||
end
|
||||
|
|
|
|||
|
|
@ -24,4 +24,5 @@ CONTAINS
|
|||
WRITE(*,*) x, y
|
||||
END SUBROUTINE
|
||||
END MODULE
|
||||
|
||||
! { dg-final { cleanup-modules "global" } }
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ module z
|
|||
use y
|
||||
|
||||
interface ambiguous
|
||||
module procedure f ! { dg-error "in generic interface" "" }
|
||||
module procedure f ! { dg-warning "in generic interface" "" }
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
|
|
|||
46
gcc/testsuite/gfortran.dg/interface_4.f90
Normal file
46
gcc/testsuite/gfortran.dg/interface_4.f90
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
! { dg-do run }
|
||||
! Tests the fix for the interface bit of PR29975, in which the
|
||||
! interfaces bl_copy were rejected as ambiguous, even though
|
||||
! they import different specific interfaces.
|
||||
!
|
||||
! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
|
||||
! simplified by Tobias Burnus <burnus@gcc.gnu.org>
|
||||
!
|
||||
SUBROUTINE RECOPY(N, c)
|
||||
real, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
c = "recopy"
|
||||
END SUBROUTINE RECOPY
|
||||
|
||||
MODULE f77_blas_extra
|
||||
PUBLIC :: BL_COPY
|
||||
INTERFACE BL_COPY
|
||||
MODULE PROCEDURE SDCOPY
|
||||
END INTERFACE BL_COPY
|
||||
CONTAINS
|
||||
SUBROUTINE SDCOPY(N, c)
|
||||
INTEGER, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
c = "sdcopy"
|
||||
END SUBROUTINE SDCOPY
|
||||
END MODULE f77_blas_extra
|
||||
|
||||
MODULE f77_blas_generic
|
||||
INTERFACE BL_COPY
|
||||
SUBROUTINE RECOPY(N, c)
|
||||
real, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
END SUBROUTINE RECOPY
|
||||
END INTERFACE BL_COPY
|
||||
END MODULE f77_blas_generic
|
||||
|
||||
program main
|
||||
USE f77_blas_extra
|
||||
USE f77_blas_generic
|
||||
character(6) :: chr
|
||||
call bl_copy(1, chr)
|
||||
if (chr /= "sdcopy") call abort ()
|
||||
call bl_copy(1.0, chr)
|
||||
if (chr /= "recopy") call abort ()
|
||||
end program main
|
||||
! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
|
||||
56
gcc/testsuite/gfortran.dg/interface_5.f90
Normal file
56
gcc/testsuite/gfortran.dg/interface_5.f90
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
! { dg-do compile }
|
||||
! Tests the fix for the interface bit of PR29975, in which the
|
||||
! interfaces bl_copy were rejected as ambiguous, even though
|
||||
! they import different specific interfaces. In this testcase,
|
||||
! it is verified that ambiguous specific interfaces are caught.
|
||||
!
|
||||
! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
|
||||
! simplified by Tobias Burnus <burnus@gcc.gnu.org>
|
||||
!
|
||||
SUBROUTINE RECOPY(N, c)
|
||||
real, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
print *, n
|
||||
c = "recopy"
|
||||
END SUBROUTINE RECOPY
|
||||
|
||||
MODULE f77_blas_extra
|
||||
PUBLIC :: BL_COPY
|
||||
INTERFACE BL_COPY
|
||||
MODULE PROCEDURE SDCOPY
|
||||
END INTERFACE BL_COPY
|
||||
CONTAINS
|
||||
SUBROUTINE SDCOPY(N, c)
|
||||
REAL, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
print *, n
|
||||
c = "sdcopy"
|
||||
END SUBROUTINE SDCOPY
|
||||
END MODULE f77_blas_extra
|
||||
|
||||
MODULE f77_blas_generic
|
||||
INTERFACE BL_COPY
|
||||
SUBROUTINE RECOPY(N, c)
|
||||
real, INTENT(IN) :: N
|
||||
character(6) :: c
|
||||
END SUBROUTINE RECOPY
|
||||
END INTERFACE BL_COPY
|
||||
END MODULE f77_blas_generic
|
||||
|
||||
subroutine i_am_ok
|
||||
USE f77_blas_extra ! { dg-warning "ambiguous interfaces" }
|
||||
USE f77_blas_generic
|
||||
character(6) :: chr
|
||||
chr = ""
|
||||
if (chr /= "recopy") call abort ()
|
||||
end subroutine i_am_ok
|
||||
|
||||
program main
|
||||
USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
|
||||
USE f77_blas_generic
|
||||
character(6) :: chr
|
||||
chr = ""
|
||||
call bl_copy(1.0, chr)
|
||||
if (chr /= "recopy") call abort ()
|
||||
end program main
|
||||
! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
|
||||
24
gcc/testsuite/gfortran.dg/interface_6.f90
Normal file
24
gcc/testsuite/gfortran.dg/interface_6.f90
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
! { dg-do compile }
|
||||
! One of the tests of the patch for PR30068.
|
||||
! Taken from the fortran 2003 standard C11.2.
|
||||
!
|
||||
! The standard specifies that the optional arguments should be
|
||||
! ignored in the counting of like type/kind, so the specific
|
||||
! procedures below are invalid, even though actually unambiguous.
|
||||
!
|
||||
INTERFACE BAD8
|
||||
SUBROUTINE S8A(X,Y,Z)
|
||||
REAL,OPTIONAL :: X
|
||||
INTEGER :: Y
|
||||
REAL :: Z
|
||||
END SUBROUTINE S8A
|
||||
SUBROUTINE S8B(X,Z,Y)
|
||||
INTEGER,OPTIONAL :: X
|
||||
INTEGER :: Z
|
||||
REAL :: Y
|
||||
END SUBROUTINE S8B ! { dg-error "Ambiguous interfaces" }
|
||||
END INTERFACE BAD8
|
||||
real :: a, b
|
||||
integer :: i, j
|
||||
call bad8(x,i,b)
|
||||
end
|
||||
32
gcc/testsuite/gfortran.dg/interface_7.f90
Normal file
32
gcc/testsuite/gfortran.dg/interface_7.f90
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
! { dg-do compile }
|
||||
! One of the tests of the patch for PR30068.
|
||||
! Taken from the fortran 2003 standard C11.2.
|
||||
!
|
||||
! The interface is invalid although it is unambiguous because the
|
||||
! standard explicitly does not require recursion into the formal
|
||||
! arguments of procedures that themselves are interface arguments.
|
||||
!
|
||||
module x
|
||||
INTERFACE BAD9
|
||||
SUBROUTINE S9A(X)
|
||||
REAL :: X
|
||||
END SUBROUTINE S9A
|
||||
SUBROUTINE S9B(X)
|
||||
INTERFACE
|
||||
FUNCTION X(A)
|
||||
REAL :: X,A
|
||||
END FUNCTION X
|
||||
END INTERFACE
|
||||
END SUBROUTINE S9B
|
||||
SUBROUTINE S9C(X)
|
||||
INTERFACE
|
||||
FUNCTION X(A)
|
||||
REAL :: X
|
||||
INTEGER :: A
|
||||
END FUNCTION X
|
||||
END INTERFACE
|
||||
END SUBROUTINE S9C ! { dg-error "Ambiguous interfaces" }
|
||||
END INTERFACE BAD9
|
||||
end module x
|
||||
|
||||
! { dg-final { cleanup-modules "x" } }
|
||||
30
gcc/testsuite/gfortran.dg/interface_8.f90
Normal file
30
gcc/testsuite/gfortran.dg/interface_8.f90
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
! { dg-do compile }
|
||||
! One of the tests of the patch for PR30068.
|
||||
! Taken from comp.lang.fortran 3rd December 2006.
|
||||
!
|
||||
! Although the generic procedure is not referenced and it would
|
||||
! normally be permissible for it to be ambiguous, the USE, ONLY
|
||||
! statement is effectively a reference and is invalid.
|
||||
!
|
||||
module mod1
|
||||
interface generic
|
||||
subroutine foo(a)
|
||||
real :: a
|
||||
end subroutine
|
||||
end interface generic
|
||||
end module mod1
|
||||
|
||||
module mod2
|
||||
interface generic
|
||||
subroutine bar(a)
|
||||
real :: a
|
||||
end subroutine
|
||||
end interface generic
|
||||
end module mod2
|
||||
|
||||
program main
|
||||
use mod1, only: generic ! { dg-warning "has ambiguous interfaces" }
|
||||
use mod2
|
||||
end program main
|
||||
|
||||
! { dg-final { cleanup-modules "mod1 mod2" } }
|
||||
47
gcc/testsuite/gfortran.dg/interface_9.f90
Normal file
47
gcc/testsuite/gfortran.dg/interface_9.f90
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
! { dg-do compile }
|
||||
! Test of the patch for PR30096, in which gfortran incorrectly.
|
||||
! compared local with host associated interfaces.
|
||||
!
|
||||
! Based on contribution by Harald Anlauf <anlauf@gmx.de>
|
||||
!
|
||||
module module1
|
||||
interface inverse
|
||||
module procedure A, B
|
||||
end interface
|
||||
contains
|
||||
function A (X) result (Y)
|
||||
real :: X, Y
|
||||
Y = 1.0
|
||||
end function A
|
||||
function B (X) result (Y)
|
||||
integer :: X, Y
|
||||
Y = 3
|
||||
end function B
|
||||
end module module1
|
||||
|
||||
module module2
|
||||
interface inverse
|
||||
module procedure C
|
||||
end interface
|
||||
contains
|
||||
function C (X) result (Y)
|
||||
real :: X, Y
|
||||
Y = 2.0
|
||||
end function C
|
||||
end module module2
|
||||
|
||||
program gfcbug48
|
||||
use module1, only : inverse
|
||||
call sub ()
|
||||
if (inverse(1.0_4) /= 1.0_4) call abort ()
|
||||
if (inverse(1_4) /= 3_4) call abort ()
|
||||
contains
|
||||
subroutine sub ()
|
||||
use module2, only : inverse
|
||||
if (inverse(1.0_4) /= 2.0_4) call abort ()
|
||||
if (inverse(1_4) /= 3_4) call abort ()
|
||||
end subroutine sub
|
||||
end program gfcbug48
|
||||
|
||||
! { dg-final { cleanup-modules "module1 module2" } }
|
||||
|
||||
Loading…
Add table
Reference in a new issue