flang/test/Semantics/assign09.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Procedure pointer assignments and argument association with intrinsic functions
   3 program test
   4   abstract interface
   5     real function realToReal(a)
   6       real, intent(in) :: a
   7     end function
   8     real function intToReal(n)
   9       integer, intent(in) :: n
  10     end function
  11   end interface
  12   procedure(), pointer :: noInterfaceProcPtr
  13   procedure(realToReal), pointer :: realToRealProcPtr
  14   procedure(intToReal), pointer :: intToRealProcPtr
  15   intrinsic :: float ! restricted specific intrinsic functions
  16   intrinsic :: sqrt ! unrestricted specific intrinsic functions
  17   external :: noInterfaceExternal
  18   interface
  19     elemental real function userElemental(a)
  20       real, intent(in) :: a
  21     end function
  22   end interface
  23
  24   !ERROR: 'float' is not an unrestricted specific intrinsic procedure
  25   noInterfaceProcPtr => float
  26   !ERROR: 'float' is not an unrestricted specific intrinsic procedure
  27   intToRealProcPtr => float
  28   !ERROR: 'float' is not an unrestricted specific intrinsic procedure
  29   call sub1(float)
  30   !ERROR: 'float' is not an unrestricted specific intrinsic procedure
  31   call sub2(float)
  32   !ERROR: 'float' is not an unrestricted specific intrinsic procedure
  33   call sub3(float)
  34
  35   noInterfaceProcPtr => sqrt ! ok
  36   realToRealProcPtr => sqrt ! ok
  37   !ERROR: Procedure pointer 'inttorealprocptr' associated with incompatible procedure designator 'sqrt': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
  38   intToRealProcPtr => sqrt
  39   call sub1(sqrt) ! ok
  40   call sub2(sqrt) ! ok
  41   !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
  42   call sub3(sqrt)
  43
  44   noInterfaceProcPtr => noInterfaceExternal ! ok
  45   realToRealProcPtr => noInterfaceExternal ! ok
  46   intToRealProcPtr => noInterfaceExternal !ok
  47   call sub1(noInterfaceExternal) ! ok
  48   !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
  49   call sub2(noInterfaceExternal)
  50   !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
  51   call sub3(noInterfaceExternal)
  52
  53   !ERROR: Procedure pointer 'nointerfaceprocptr' with implicit interface may not be associated with procedure designator 'userelemental' with explicit interface that cannot be called via an implicit interface
  54   noInterfaceProcPtr => userElemental
  55   !ERROR: Non-intrinsic ELEMENTAL procedure 'userelemental' may not be passed as an actual argument
  56   call sub1(userElemental)
  57
  58  contains
  59   subroutine sub1(p)
  60     external :: p
  61   end subroutine
  62   subroutine sub2(p)
  63     procedure(realToReal) :: p
  64   end subroutine
  65   subroutine sub3(p)
  66     procedure(intToReal) :: p
  67   end subroutine
  68 end