141 lines · plain
1! RUN: bbc -emit-hlfir -o - %s | FileCheck %s2! Ensure that copy-in/copy-out happens with specific ignore_tkr settings3module test4 interface5 subroutine pass_ignore_tkr(buf)6 implicit none7 !DIR$ IGNORE_TKR buf8 real :: buf9 end subroutine10 subroutine pass_ignore_tkr_2(buf)11 implicit none12 !DIR$ IGNORE_TKR(tkrdm) buf13 type(*) :: buf14 end subroutine15 subroutine pass_ignore_tkr_c(buf)16 implicit none17 !DIR$ IGNORE_TKR (tkrc) buf18 real :: buf19 end subroutine20 subroutine pass_ignore_tkr_c_2(buf)21 implicit none22 !DIR$ IGNORE_TKR (tkrcdm) buf23 type(*) :: buf24 end subroutine25 subroutine pass_intent_out(buf)26 implicit none27 integer, intent(out) :: buf(5)28 end subroutine29 end interface30 31 ! Used by call_s6() and others below32 type base33 integer :: i = -134 end type35 type, extends (base) :: child36 real :: r = -2.037 end type38contains39 subroutine s1(buf)40!CHECK-LABEL: func.func @_QMtestPs141!CHECK: hlfir.copy_in42!CHECK: fir.call @_QPpass_ignore_tkr43!CHECK: hlfir.copy_out44 real, intent(inout) :: buf(:)45 ! Create temp here46 call pass_ignore_tkr(buf)47 end subroutine48 subroutine s2(buf)49!CHECK-LABEL: func.func @_QMtestPs250!CHECK-NOT: hlfir.copy_in51!CHECK: fir.call @_QPpass_ignore_tkr_c52!CHECK-NOT: hlfir.copy_out53 real, intent(inout) :: buf(:)54 ! Don't create temp here55 call pass_ignore_tkr_c(buf)56 end subroutine57 subroutine s3(buf)58!CHECK-LABEL: func.func @_QMtestPs359!CHECK: hlfir.copy_in60!CHECK: fir.call @_QPpass_ignore_tkr_261!CHECK: hlfir.copy_out62 real, intent(inout) :: buf(:)63 ! Create temp here64 call pass_ignore_tkr_2(buf)65 end subroutine66 subroutine s4(buf)67!CHECK-LABEL: func.func @_QMtestPs468!CHECK-NOT: hlfir.copy_in69!CHECK: fir.call @_QPpass_ignore_tkr_c_270!CHECK-NOT: hlfir.copy_out71 real, intent(inout) :: buf(:)72 ! Don't create temp here73 call pass_ignore_tkr_c_2(buf)74 end subroutine75 subroutine s5()76 ! TODO: pass_intent_out() has intent(out) dummy argument, so as such it77 ! should have copy-out, but not copy-in. Unfortunately, at the moment flang78 ! can only do copy-in/copy-out together. When this is fixed, this test should79 ! change from 'CHECK' for hlfir.copy_in to 'CHECK-NOT' for hlfir.copy_in80!CHECK-LABEL: func.func @_QMtestPs581!CHECK: hlfir.copy_in82!CHECK: fir.call @_QPpass_intent_out83!CHECK: hlfir.copy_out84 implicit none85 integer, target :: x(10)86 integer, pointer :: p(:)87 p => x(::2) ! pointer to non-contiguous array section88 call pass_intent_out(p)89 end subroutine90 subroutine call_s6()91 interface92 subroutine s6(b)93 import :: base94 type(base), intent(inout) :: b(:)95 end subroutine s696 end interface97 class(base), pointer :: pb(:)98 type(child), target :: c(2)99!CHECK-LABEL: func.func @_QMtestPcall_s6100!CHECK-NOT: hlfir.copy_in101!CHECK: fir.call @_QPs6102!CHECK-NOT: hlfir.copy_out103 pb => c104 call s6(pb)105 end subroutine call_s6106 subroutine call_s7()107 interface108 subroutine s7(b1, b2, n)109 import :: base110 integer :: n111 type(base), intent(inout) :: b1(n)112 type(base), intent(inout) :: b2(*)113 end subroutine114 end interface115 integer, parameter :: n = 7116 class(base), allocatable :: c1(:), c2(:)117!CHECK-LABEL: func.func @_QMtestPcall_s7118!CHECK: hlfir.copy_in119!CHECK: hlfir.copy_in120!CHECK: fir.call @_QPs7121!CHECK: hlfir.copy_out122!CHECK: hlfir.copy_out123 call s7(c1, c2, n)124 end subroutine call_s7125 subroutine call_s8()126 interface127 subroutine s8(buf)128 ! IGNORE_TKR(C) takes precendence over CONTIGUOUS129 !DIR$ IGNORE_TKR(C) buf130 real, contiguous :: buf(:)131 end subroutine132 end interface133 real a(10)134!CHECK-LABEL: func.func @_QMtestPcall_s8135!CHECK-NOT: hlfir.copy_in136!CHECK: fir.call @_QPs8137!CHECK-NOT: hlfir.copy_out138 call s8(a(1:5:2))139 end subroutine call_s8140end module141