PR fortran/63797 - Bogus ambiguous reference to 'sqrt'

The interface of an intrinsic procedure is automatically explicit.
Do not write it to the module file to prevent wrong ambiguities on USE.

gcc/fortran/ChangeLog:

	PR fortran/63797
	* module.c (write_symtree): Do not write interface of intrinsic
	procedure to module file for F2003 and newer.

gcc/testsuite/ChangeLog:

	PR fortran/63797
	* gfortran.dg/pr63797.f90: New test.

Co-authored-by: Paul Thomas <pault@gcc.gnu.org>
This commit is contained in:
Harald Anlauf 2021-04-16 16:24:31 +02:00
parent 330ae1e543
commit d264194c10
2 changed files with 71 additions and 0 deletions

View File

@ -6218,6 +6218,17 @@ write_symtree (gfc_symtree *st)
if (check_unique_name (st->name))
return;
/* From F2003 onwards, intrinsic procedures are no longer subject to
the restriction, "that an elemental intrinsic function here be of
type integer or character and each argument must be an initialization
expr of type integer or character" is lifted so that intrinsic
procedures can be over-ridden. This requires that the intrinsic
symbol not appear in the module file, thereby preventing ambiguity
when USEd. */
if (strcmp (sym->module, "(intrinsic)") == 0
&& (gfc_option.allow_std & GFC_STD_F2003))
return;
p = find_pointer (sym);
if (p == NULL)
gfc_internal_error ("write_symtree(): Symbol not written");

View File

@ -0,0 +1,60 @@
! { dg-do compile }
! PR63797 - Bogus ambiguous reference to 'sqrt'
module mod1
implicit none
real, parameter :: z = sqrt (0.0)
real :: w = sqrt (1.0)
interface
pure real function sqrt_ifc (x)
real, intent(in) :: x
end function sqrt_ifc
end interface
contains
pure function myroot () result (f)
procedure(sqrt_ifc), pointer :: f
intrinsic :: sqrt
f => sqrt
end function myroot
end module mod1
module mod2
implicit none
type t
real :: a = 0.
end type
interface sqrt
module procedure sqrt
end interface
contains
elemental function sqrt (a)
type(t), intent(in) :: a
type(t) :: sqrt
sqrt% a = a% a
end function sqrt
end module mod2
module mod3
implicit none
abstract interface
function real_func (x)
real :: real_func
real, intent (in) :: x
end function real_func
end interface
intrinsic :: sqrt
procedure(real_func), pointer :: real_root => sqrt
end module mod3
program test
use mod1
use mod2
use mod3
implicit none
type(t) :: x, y
procedure(sqrt_ifc), pointer :: root
root => myroot ()
y = sqrt (x)
y% a = sqrt (x% a) + z - w + root (x% a)
y% a = real_root (x% a)
end program test