brintos

brintos / llvm-project-archived public Read only

0
0
Text · 3.1 KiB · 7c95e3a Raw
73 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! Procedure pointer assignments and argument association with intrinsic functions3program test4  abstract interface5    real function realToReal(a)6      real, intent(in) :: a7    end function8    real function intToReal(n)9      integer, intent(in) :: n10    end function11  end interface12  procedure(), pointer :: noInterfaceProcPtr13  procedure(realToReal), pointer :: realToRealProcPtr14  procedure(intToReal), pointer :: intToRealProcPtr15  intrinsic :: float ! restricted specific intrinsic functions16  intrinsic :: sqrt ! unrestricted specific intrinsic functions17  external :: noInterfaceExternal18  interface19    elemental real function userElemental(a)20      real, intent(in) :: a21    end function22  end interface23 24  !ERROR: 'float' is not an unrestricted specific intrinsic procedure25  noInterfaceProcPtr => float26  !ERROR: 'float' is not an unrestricted specific intrinsic procedure27  intToRealProcPtr => float28  !ERROR: 'float' is not an unrestricted specific intrinsic procedure29  call sub1(float)30  !ERROR: 'float' is not an unrestricted specific intrinsic procedure31  call sub2(float)32  !ERROR: 'float' is not an unrestricted specific intrinsic procedure33  call sub3(float)34 35  noInterfaceProcPtr => sqrt ! ok36  realToRealProcPtr => sqrt ! ok37  !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 => sqrt39  call sub1(sqrt) ! ok40  call sub2(sqrt) ! ok41  !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  print *, implicitExtFunc()45  call implicitExtSubr46  noInterfaceProcPtr => implicitExtFunc ! ok47  noInterfaceProcPtr => implicitExtSubr ! ok48  noInterfaceProcPtr => noInterfaceExternal ! ok49  realToRealProcPtr => noInterfaceExternal ! ok50  intToRealProcPtr => noInterfaceExternal !ok51  call sub1(noInterfaceExternal) ! ok52  !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface [-Wimplicit-interface-actual]53  call sub2(noInterfaceExternal)54  !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface [-Wimplicit-interface-actual]55  call sub3(noInterfaceExternal)56 57  !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 interface58  noInterfaceProcPtr => userElemental59  !ERROR: Non-intrinsic ELEMENTAL procedure 'userelemental' may not be passed as an actual argument60  call sub1(userElemental)61 62 contains63  subroutine sub1(p)64    external :: p65  end subroutine66  subroutine sub2(p)67    procedure(realToReal) :: p68  end subroutine69  subroutine sub3(p)70    procedure(intToReal) :: p71  end subroutine72end73