brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.6 KiB · 8edbba5 Raw
59 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Interfaces are allowed to extend intrinsic procedures, with limitations3module m14  intrinsic sin5  interface sin6    module procedure :: charcpy7  end interface8  interface cos ! no INTRINSIC statement9    module procedure :: charcpy10  end interface11  intrinsic mvbits12  interface mvbits13    module procedure :: negate14  end interface15  interface move_alloc ! no INTRINSIC statement16    module procedure :: negate17  end interface18  interface tan ! not explicitly INTRINSIC19    module procedure :: negate ! a subroutine20  end interface21  interface acos22    module procedure :: minus ! override23  end interface24  intrinsic atan25  !ERROR: Generic interface 'atan' with explicit intrinsic function of the same name may not have specific procedure 'negate' that is a subroutine26  interface atan27    module procedure :: negate ! a subroutine28  end interface29 contains30  character function charcpy(x)31    character, intent(in) :: x32    charcpy = x33  end function34  subroutine negate(x)35    real, intent(in out) :: x36    x = -x37  end subroutine38  real elemental function minus(x)39    real, intent(in) :: x40    minus = -x41  end function42  subroutine test43    integer, allocatable :: j, k44    real :: x45    character :: str46    x = sin(x)47    str = sin(str) ! charcpy48    x = cos(x)49    str = cos(str) ! charcpy50    call mvbits(j,0,1,k,0)51    call mvbits(x) ! negate52    call move_alloc(j, k)53    call move_alloc(x) ! negate54    !ERROR: Cannot call subroutine 'tan' like a function55    x = tan(x)56    x = acos(x) ! user's interface overrides intrinsic57  end subroutine58end module59