xref: /llvm-project/flang/test/Semantics/assign09.f90 (revision ccd78958f696af7e2d3451c1291640cada4ef6ab)
1191d4872SPeter Klausler! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
295f4ca7fSPeter Klausler! Procedure pointer assignments and argument association with intrinsic functions
395f4ca7fSPeter Klauslerprogram test
495f4ca7fSPeter Klausler  abstract interface
595f4ca7fSPeter Klausler    real function realToReal(a)
695f4ca7fSPeter Klausler      real, intent(in) :: a
795f4ca7fSPeter Klausler    end function
895f4ca7fSPeter Klausler    real function intToReal(n)
995f4ca7fSPeter Klausler      integer, intent(in) :: n
1095f4ca7fSPeter Klausler    end function
1195f4ca7fSPeter Klausler  end interface
1295f4ca7fSPeter Klausler  procedure(), pointer :: noInterfaceProcPtr
1395f4ca7fSPeter Klausler  procedure(realToReal), pointer :: realToRealProcPtr
1495f4ca7fSPeter Klausler  procedure(intToReal), pointer :: intToRealProcPtr
1595f4ca7fSPeter Klausler  intrinsic :: float ! restricted specific intrinsic functions
1695f4ca7fSPeter Klausler  intrinsic :: sqrt ! unrestricted specific intrinsic functions
1795f4ca7fSPeter Klausler  external :: noInterfaceExternal
1895f4ca7fSPeter Klausler  interface
1995f4ca7fSPeter Klausler    elemental real function userElemental(a)
2095f4ca7fSPeter Klausler      real, intent(in) :: a
2195f4ca7fSPeter Klausler    end function
2295f4ca7fSPeter Klausler  end interface
2395f4ca7fSPeter Klausler
2495f4ca7fSPeter Klausler  !ERROR: 'float' is not an unrestricted specific intrinsic procedure
2595f4ca7fSPeter Klausler  noInterfaceProcPtr => float
2695f4ca7fSPeter Klausler  !ERROR: 'float' is not an unrestricted specific intrinsic procedure
2795f4ca7fSPeter Klausler  intToRealProcPtr => float
2895f4ca7fSPeter Klausler  !ERROR: 'float' is not an unrestricted specific intrinsic procedure
2995f4ca7fSPeter Klausler  call sub1(float)
3095f4ca7fSPeter Klausler  !ERROR: 'float' is not an unrestricted specific intrinsic procedure
3195f4ca7fSPeter Klausler  call sub2(float)
3295f4ca7fSPeter Klausler  !ERROR: 'float' is not an unrestricted specific intrinsic procedure
3395f4ca7fSPeter Klausler  call sub3(float)
3495f4ca7fSPeter Klausler
3595f4ca7fSPeter Klausler  noInterfaceProcPtr => sqrt ! ok
3695f4ca7fSPeter Klausler  realToRealProcPtr => sqrt ! ok
37036701a1SPeter Klausler  !ERROR: Procedure pointer 'inttorealprocptr' associated with incompatible procedure designator 'sqrt': incompatible dummy argument #1: incompatible dummy data object types: REAL(4) vs INTEGER(4)
3895f4ca7fSPeter Klausler  intToRealProcPtr => sqrt
3995f4ca7fSPeter Klausler  call sub1(sqrt) ! ok
4095f4ca7fSPeter Klausler  call sub2(sqrt) ! ok
41036701a1SPeter Klausler  !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)
4295f4ca7fSPeter Klausler  call sub3(sqrt)
4395f4ca7fSPeter Klausler
44*ccd78958SPeter Klausler  print *, implicitExtFunc()
45*ccd78958SPeter Klausler  call implicitExtSubr
46*ccd78958SPeter Klausler  noInterfaceProcPtr => implicitExtFunc ! ok
47*ccd78958SPeter Klausler  noInterfaceProcPtr => implicitExtSubr ! ok
4895f4ca7fSPeter Klausler  noInterfaceProcPtr => noInterfaceExternal ! ok
4995f4ca7fSPeter Klausler  realToRealProcPtr => noInterfaceExternal ! ok
5095f4ca7fSPeter Klausler  intToRealProcPtr => noInterfaceExternal !ok
5195f4ca7fSPeter Klausler  call sub1(noInterfaceExternal) ! ok
5295f4ca7fSPeter Klausler  !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
5395f4ca7fSPeter Klausler  call sub2(noInterfaceExternal)
5495f4ca7fSPeter Klausler  !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
5595f4ca7fSPeter Klausler  call sub3(noInterfaceExternal)
5695f4ca7fSPeter Klausler
5795f4ca7fSPeter Klausler  !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
5895f4ca7fSPeter Klausler  noInterfaceProcPtr => userElemental
5995f4ca7fSPeter Klausler  !ERROR: Non-intrinsic ELEMENTAL procedure 'userelemental' may not be passed as an actual argument
6095f4ca7fSPeter Klausler  call sub1(userElemental)
6195f4ca7fSPeter Klausler
6295f4ca7fSPeter Klausler contains
6395f4ca7fSPeter Klausler  subroutine sub1(p)
6495f4ca7fSPeter Klausler    external :: p
6595f4ca7fSPeter Klausler  end subroutine
6695f4ca7fSPeter Klausler  subroutine sub2(p)
6795f4ca7fSPeter Klausler    procedure(realToReal) :: p
6895f4ca7fSPeter Klausler  end subroutine
6995f4ca7fSPeter Klausler  subroutine sub3(p)
7095f4ca7fSPeter Klausler    procedure(intToReal) :: p
7195f4ca7fSPeter Klausler  end subroutine
7295f4ca7fSPeter Klauslerend
73