gcc/testsuite/gfortran.fortran-torture/execute/userop.f90

   1 module uops
   2    implicit none
   3    interface operator (.foo.)
   4       module procedure myfoo
   5    end interface
   6
   7    interface operator (*)
   8       module procedure boolmul
   9    end interface
  10
  11    interface assignment (=)
  12       module procedure int2bool
  13    end interface
  14
  15 contains
  16 function myfoo (lhs, rhs)
  17    implicit none
  18    integer myfoo
  19    integer, intent(in) :: lhs, rhs
  20
  21    myfoo = lhs + rhs
  22 end function
  23
  24 ! This is deliberately different from integer multiplication
  25 function boolmul (lhs, rhs)
  26    implicit none
  27    logical boolmul
  28    logical, intent(IN) :: lhs, rhs
  29
  30    boolmul = lhs .and. .not. rhs
  31 end function
  32
  33 subroutine int2bool (lhs, rhs)
  34    implicit none
  35    logical, intent(out) :: lhs
  36    integer, intent(in) :: rhs
  37
  38    lhs = rhs .ne. 0
  39 end subroutine
  40 end module
  41
  42 program me
  43    use uops
  44    implicit none
  45    integer i, j
  46    logical b, c
  47
  48    b = .true.
  49    c = .true.
  50    if (b * c) call abort
  51    c = .false.
  52    if (.not. (b * c)) call abort
  53    if (c * b) call abort
  54    b = .false.
  55    if (b * c) call abort
  56
  57    i = 0
  58    b = i
  59    if (b) call abort
  60    i = 2
  61    b = i
  62    if (.not. b) call abort
  63
  64    j = 3
  65    if ((i .foo. j) .ne. 5) call abort
  66 end program
  67