]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
PR fortran/63797 - Bogus ambiguous reference to 'sqrt'
authorHarald Anlauf <anlauf@gmx.de>
Fri, 16 Apr 2021 14:24:31 +0000 (16:24 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Fri, 16 Apr 2021 14:24:31 +0000 (16:24 +0200)
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>
gcc/fortran/module.c
gcc/testsuite/gfortran.dg/pr63797.f90 [new file with mode: 0644]

index 4db0a3ac76d036c095887f56d33fb6214f3941a1..089453caa03ba52b48cdfee19bb8dfd3005d37a8 100644 (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");
diff --git a/gcc/testsuite/gfortran.dg/pr63797.f90 b/gcc/testsuite/gfortran.dg/pr63797.f90
new file mode 100644 (file)
index 0000000..1131e81
--- /dev/null
@@ -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