xref: /llvm-project/flang/test/Semantics/assign09.f90 (revision ccd78958f696af7e2d3451c1291640cada4ef6ab)
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2! Procedure pointer assignments and argument association with intrinsic functions
3program 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  print *, implicitExtFunc()
45  call implicitExtSubr
46  noInterfaceProcPtr => implicitExtFunc ! ok
47  noInterfaceProcPtr => implicitExtSubr ! ok
48  noInterfaceProcPtr => noInterfaceExternal ! ok
49  realToRealProcPtr => noInterfaceExternal ! ok
50  intToRealProcPtr => noInterfaceExternal !ok
51  call sub1(noInterfaceExternal) ! ok
52  !WARNING: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explicit interface
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
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 interface
58  noInterfaceProcPtr => userElemental
59  !ERROR: Non-intrinsic ELEMENTAL procedure 'userelemental' may not be passed as an actual argument
60  call sub1(userElemental)
61
62 contains
63  subroutine sub1(p)
64    external :: p
65  end subroutine
66  subroutine sub2(p)
67    procedure(realToReal) :: p
68  end subroutine
69  subroutine sub3(p)
70    procedure(intToReal) :: p
71  end subroutine
72end
73