flang/test/Lower/force-temp.f90

! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
! Ensure that copy-in/copy-out happens with specific ignore_tkr settings
module test
  interface
    subroutine pass_ignore_tkr(buf)
      implicit none
      !DIR$ IGNORE_TKR buf
      real :: buf
    end subroutine
    subroutine pass_ignore_tkr_2(buf)
      implicit none
      !DIR$ IGNORE_TKR(tkrdm) buf
      type(*) :: buf
    end subroutine
    subroutine pass_ignore_tkr_c(buf)
      implicit none
      !DIR$ IGNORE_TKR (tkrc) buf
      real :: buf
    end subroutine
    subroutine pass_ignore_tkr_c_2(buf)
      implicit none
      !DIR$ IGNORE_TKR (tkrcdm) buf
      type(*) :: buf
    end subroutine
    subroutine pass_intent_out(buf)
      implicit none
      integer, intent(out) :: buf(5)
    end subroutine
  end interface

  ! Used by call_s6() and others below
  type base
    integer :: i = -1
  end type
  type, extends (base) :: child
    real :: r = -2.0
  end type
contains
  subroutine s1(buf)
!CHECK-LABEL: func.func @_QMtestPs1
!CHECK: hlfir.copy_in
!CHECK: fir.call @_QPpass_ignore_tkr
!CHECK: hlfir.copy_out
    real, intent(inout) :: buf(:)
    ! Create temp here
    call pass_ignore_tkr(buf)
  end subroutine
  subroutine s2(buf)
!CHECK-LABEL: func.func @_QMtestPs2
!CHECK-NOT: hlfir.copy_in
!CHECK: fir.call @_QPpass_ignore_tkr_c
!CHECK-NOT: hlfir.copy_out
    real, intent(inout) :: buf(:)
    ! Don't create temp here
    call pass_ignore_tkr_c(buf)
  end subroutine
  subroutine s3(buf)
!CHECK-LABEL: func.func @_QMtestPs3
!CHECK: hlfir.copy_in
!CHECK: fir.call @_QPpass_ignore_tkr_2
!CHECK: hlfir.copy_out
    real, intent(inout) :: buf(:)
    ! Create temp here
    call pass_ignore_tkr_2(buf)
  end subroutine
  subroutine s4(buf)
!CHECK-LABEL: func.func @_QMtestPs4
!CHECK-NOT: hlfir.copy_in
!CHECK: fir.call @_QPpass_ignore_tkr_c_2
!CHECK-NOT: hlfir.copy_out
    real, intent(inout) :: buf(:)
    ! Don't create temp here
    call pass_ignore_tkr_c_2(buf)
  end subroutine
  subroutine s5()
  ! TODO: pass_intent_out() has intent(out) dummy argument, so as such it
  ! should have copy-out, but not copy-in. Unfortunately, at the moment flang
  ! can only do copy-in/copy-out together. When this is fixed, this test should
  ! change from 'CHECK' for hlfir.copy_in to 'CHECK-NOT' for hlfir.copy_in
!CHECK-LABEL: func.func @_QMtestPs5
!CHECK: hlfir.copy_in
!CHECK: fir.call @_QPpass_intent_out
!CHECK: hlfir.copy_out
    implicit none
    integer, target :: x(10)
    integer, pointer :: p(:)
    p => x(::2) ! pointer to non-contiguous array section
    call pass_intent_out(p)
  end subroutine
  subroutine call_s6()
    interface
      subroutine s6(b)
        import :: base
        type(base), intent(inout) :: b(:)
      end subroutine s6
    end interface
    class(base), pointer :: pb(:)
    type(child), target :: c(2)
!CHECK-LABEL: func.func @_QMtestPcall_s6
!CHECK-NOT: hlfir.copy_in
!CHECK: fir.call @_QPs6
!CHECK-NOT: hlfir.copy_out
    pb => c
    call s6(pb)
  end subroutine call_s6
  subroutine call_s7()
    interface
      subroutine s7(b1, b2, n)
        import :: base
        integer :: n
        type(base), intent(inout) :: b1(n)
        type(base), intent(inout) :: b2(*)
      end subroutine
    end interface
    integer, parameter :: n = 7
    class(base), allocatable :: c1(:), c2(:)
!CHECK-LABEL: func.func @_QMtestPcall_s7
!CHECK: hlfir.copy_in
!CHECK: hlfir.copy_in
!CHECK: fir.call @_QPs7
!CHECK: hlfir.copy_out
!CHECK: hlfir.copy_out
    call s7(c1, c2, n)
  end subroutine call_s7
  subroutine call_s8()
    interface
      subroutine s8(buf)
        ! IGNORE_TKR(C) takes precendence over CONTIGUOUS
        !DIR$ IGNORE_TKR(C) buf
        real, contiguous :: buf(:)
      end subroutine
    end interface
    real a(10)
!CHECK-LABEL: func.func @_QMtestPcall_s8
!CHECK-NOT: hlfir.copy_in
!CHECK: fir.call @_QPs8
!CHECK-NOT: hlfir.copy_out
    call s8(a(1:5:2))
  end subroutine call_s8
end module