flang/test/Evaluate/logical-args.f90

   1 ! Test that actual logical arguments convert to the right kind when it is non-default
   2 ! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
   3 ! RUN: %flang_fc1 -fdebug-unparse -fdefault-integer-8 %s 2>&1 | FileCheck %s --check-prefixes CHECK-8
   4
   5 module m
   6   interface foog
   7      subroutine foo4(l)
   8        logical(kind=4), intent(in) :: l
   9      end subroutine foo4
  10      subroutine foo8(l)
  11        logical(kind=8), intent(in) :: l
  12      end subroutine foo8
  13   end interface foog
  14 end module m
  15
  16 program main
  17   use m
  18   integer :: x(10), y
  19
  20   ! CHECK: CALL foo(.true._4)
  21   ! CHECK-8: CALL foo(.true._8)
  22   call foo(.true.)
  23   ! CHECK: CALL foo(.true._4)
  24   ! CHECK-8: CALL foo(.true._8)
  25   call foo(1 < 2)
  26   ! CHECK: CALL foo(x(1_8)>y)
  27   ! CHECK-8: CALL foo(logical(x(1_8)>y,kind=8))
  28   call foo(x(1) > y)
  29   ! CHECK: CALL fooa(x>y)
  30   ! CHECK-8: CALL fooa(logical(x>y,kind=8))
  31   call fooa(x > y)
  32
  33   ! Ensure that calls to interfaces call the correct subroutine
  34   ! CHECK: CALL foo4(.true._4)
  35   ! CHECK-8: CALL foo8(.true._8)
  36   call foog(.true.)
  37   ! CHECK: CALL foo4(.true._4)
  38   ! CHECK-8: CALL foo8(.true._8)
  39   call foog(1 < 2)
  40   ! CHECK: CALL foo4(x(1_8)>y)
  41   ! CHECK-8: CALL foo8(logical(x(1_8)>y,kind=8))
  42   call foog(x(1) > y)
  43
  44  contains
  45   subroutine foo(l)
  46     logical :: l
  47   end subroutine foo
  48   subroutine fooa(l)
  49     logical :: l(10)
  50   end subroutine fooa
  51 end program main