flang/test/Semantics/resolve114.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Allow the same external or intrinsic procedure to be use-associated
   3 ! by multiple paths when they are unambiguous.
   4 module m1
   5   intrinsic :: sin
   6   intrinsic :: iabs
   7   interface
   8     subroutine ext1(a, b)
   9       integer, intent(in) :: a(:)
  10       real, intent(in) :: b(:)
  11     end subroutine
  12     subroutine ext2(a, b)
  13       real, intent(in) :: a(:)
  14       integer, intent(in) :: b(:)
  15     end subroutine
  16   end interface
  17 end module m1
  18
  19 module m2
  20   intrinsic :: sin, tan
  21   intrinsic :: iabs, idim
  22   interface
  23     subroutine ext1(a, b)
  24       integer, intent(in) :: a(:)
  25       real, intent(in) :: b(:)
  26     end subroutine
  27     subroutine ext2(a, b)
  28       real, intent(in) :: a(:)
  29       integer, intent(in) :: b(:)
  30     end subroutine
  31   end interface
  32 end module m2
  33
  34 subroutine s2a
  35   use m1
  36   use m2
  37   !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
  38   procedure(sin), pointer :: p1 => sin
  39   !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
  40   procedure(iabs), pointer :: p2 => iabs
  41   procedure(ext1), pointer :: p3 => ext1
  42   procedure(ext2), pointer :: p4 => ext2
  43 end subroutine
  44
  45 subroutine s2b
  46   use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
  47   use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
  48   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
  49   !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
  50   procedure(iface1), pointer :: p1 => x1
  51   !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
  52   procedure(iface2), pointer :: p2 => x2
  53   procedure(iface3), pointer :: p3 => x3
  54   procedure(iface4), pointer :: p4 => x4
  55 end subroutine
  56
  57 module m3
  58   use m1
  59   use m2
  60 end module
  61 subroutine s3
  62   use m3
  63   !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
  64   procedure(sin), pointer :: p1 => sin
  65   !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
  66   procedure(iabs), pointer :: p2 => iabs
  67   procedure(ext1), pointer :: p3 => ext1
  68   procedure(ext2), pointer :: p4 => ext2
  69 end subroutine
  70
  71 module m4
  72   use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
  73   use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
  74 end module
  75 subroutine s4
  76   use m4
  77   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
  78   !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
  79   procedure(iface1), pointer :: p1 => x1
  80   !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
  81   procedure(iface2), pointer :: p2 => x2
  82   procedure(iface3), pointer :: p3 => x3
  83   procedure(iface4), pointer :: p4 => x4
  84 end subroutine
  85
  86 subroutine s5
  87   use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
  88   use m2, only: x1 => tan, x2 => idim, x3 => ext2, x4 => ext1
  89   use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
  90   !PORTABILITY: Procedure pointer 'p1' should not have an ELEMENTAL intrinsic as its interface
  91   !ERROR: Reference to 'x1' is ambiguous
  92   procedure(iface1), pointer :: p1 => x1
  93   !PORTABILITY: Procedure pointer 'p2' should not have an ELEMENTAL intrinsic as its interface
  94   !ERROR: Reference to 'x2' is ambiguous
  95   procedure(iface2), pointer :: p2 => x2
  96   !ERROR: Reference to 'x3' is ambiguous
  97   procedure(iface3), pointer :: p3 => x3
  98   !ERROR: Reference to 'x4' is ambiguous
  99   procedure(iface4), pointer :: p4 => x4
 100 end subroutine