xref: /llvm-project/flang/test/Semantics/resolve109.f90 (revision eb14135e35bf2463a5c52394f311d47c18d72dee)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Interfaces are allowed to extend intrinsic procedures, with limitations
3module m1
4  intrinsic sin
5  interface sin
6    module procedure :: charcpy
7  end interface
8  interface cos ! no INTRINSIC statement
9    module procedure :: charcpy
10  end interface
11  intrinsic mvbits
12  interface mvbits
13    module procedure :: negate
14  end interface
15  interface move_alloc ! no INTRINSIC statement
16    module procedure :: negate
17  end interface
18  interface tan ! not explicitly INTRINSIC
19    module procedure :: negate ! a subroutine
20  end interface
21  interface acos
22    module procedure :: minus ! override
23  end interface
24  intrinsic atan
25  !ERROR: Generic interface 'atan' with explicit intrinsic function of the same name may not have specific procedure 'negate' that is a subroutine
26  interface atan
27    module procedure :: negate ! a subroutine
28  end interface
29 contains
30  character function charcpy(x)
31    character, intent(in) :: x
32    charcpy = x
33  end function
34  subroutine negate(x)
35    real, intent(in out) :: x
36    x = -x
37  end subroutine
38  real elemental function minus(x)
39    real, intent(in) :: x
40    minus = -x
41  end function
42  subroutine test
43    integer, allocatable :: j, k
44    real :: x
45    character :: str
46    x = sin(x)
47    str = sin(str) ! charcpy
48    x = cos(x)
49    str = cos(str) ! charcpy
50    call mvbits(j,0,1,k,0)
51    call mvbits(x) ! negate
52    call move_alloc(j, k)
53    call move_alloc(x) ! negate
54    !ERROR: Cannot call subroutine 'tan' like a function
55    x = tan(x)
56    x = acos(x) ! user's interface overrides intrinsic
57  end subroutine
58end module
59