207 lines · plain
1! RUN: bbc -emit-fir -hlfir=false %s -o - | FileCheck %s2! RUN: %flang_fc1 -fdefault-integer-8 -emit-fir -flang-deprecated-no-hlfir %s -o - | FileCheck %s3 4! Test OPTIONAL lowering on caller/callee and PRESENT intrinsic.5module opt6 implicit none7 type t8 real, allocatable :: p(:)9 end type10contains11 12! Test simple scalar optional13! CHECK-LABEL: func @_QMoptPintrinsic_scalar(14! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f32> {fir.bindc_name = "x", fir.optional}) {15subroutine intrinsic_scalar(x)16 real, optional :: x17 ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<f32>) -> i118 print *, present(x)19end subroutine20! CHECK-LABEL: @_QMoptPcall_intrinsic_scalar()21subroutine call_intrinsic_scalar()22 ! CHECK: %[[x:.*]] = fir.alloca f3223 real :: x24 ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[x]]) {{.*}}: (!fir.ref<f32>) -> ()25 call intrinsic_scalar(x)26 ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<f32>27 ! CHECK: fir.call @_QMoptPintrinsic_scalar(%[[absent]]) {{.*}}: (!fir.ref<f32>) -> ()28 call intrinsic_scalar()29end subroutine30 31! Test explicit shape array optional32! CHECK-LABEL: func @_QMoptPintrinsic_f77_array(33! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.array<100xf32>> {fir.bindc_name = "x", fir.optional}) {34subroutine intrinsic_f77_array(x)35 real, optional :: x(100)36 ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.array<100xf32>>) -> i137 print *, present(x)38end subroutine39! CHECK-LABEL: func @_QMoptPcall_intrinsic_f77_array()40subroutine call_intrinsic_f77_array()41 ! CHECK: %[[x:.*]] = fir.alloca !fir.array<100xf32>42 real :: x(100)43 ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[x]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()44 call intrinsic_f77_array(x)45 ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>46 ! CHECK: fir.call @_QMoptPintrinsic_f77_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.array<100xf32>>) -> ()47 call intrinsic_f77_array()48end subroutine49 50! Test optional character scalar51! CHECK-LABEL: func @_QMoptPcharacter_scalar(52! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1> {fir.bindc_name = "x", fir.optional}) {53subroutine character_scalar(x)54 ! CHECK: %[[unboxed:.*]]:2 = fir.unboxchar %[[arg0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)55 ! CHECK: %[[ref:.*]] = fir.convert %[[unboxed]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,10>>56 character(10), optional :: x57 ! CHECK: fir.is_present %[[ref]] : (!fir.ref<!fir.char<1,10>>) -> i158 print *, present(x)59end subroutine60! CHECK-LABEL: func @_QMoptPcall_character_scalar()61subroutine call_character_scalar()62 ! CHECK: %[[addr:.*]] = fir.alloca !fir.char<1,10>63 character(10) :: x64 ! CHECK: %[[x:.*]] = fir.emboxchar %[[addr]], {{.*}}65 ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[x]]) {{.*}}: (!fir.boxchar<1>) -> ()66 call character_scalar(x)67 ! CHECK: %[[absent:.*]] = fir.absent !fir.boxchar<1>68 ! CHECK: fir.call @_QMoptPcharacter_scalar(%[[absent]]) {{.*}}: (!fir.boxchar<1>) -> ()69 call character_scalar()70end subroutine71 72! Test optional character function73! CHECK-LABEL: func @_QMoptPchar_proc(74! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.char<1,3>>,75character(len=3) function char_proc(i)76 integer :: i77 char_proc = "XYZ"78end function79! CHECK-LABEL: func @_QMoptPuse_char_proc(80! CHECK-SAME: %[[arg0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc},81subroutine use_char_proc(f, c)82 optional :: f83 interface84 character(len=3) function f(i)85 integer :: i86 end function87 end interface88 character(len=3) :: c89! CHECK: %[[boxProc:.*]] = fir.extract_value %[[arg0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>90! CHECK: %[[procAddr:.*]] = fir.box_addr %[[boxProc]] : (!fir.boxproc<() -> ()>) -> (() -> ())91! CHECK: %{{.*}} = fir.is_present %[[procAddr]] : (() -> ()) -> i192 if (present(f)) then93 c = f(0)94 else95 c = "ABC"96 end if97end subroutine98! CHECK-LABEL: func @_QMoptPcall_use_char_proc(99subroutine call_use_char_proc()100 character(len=3) :: c101! CHECK: %[[boxProc:.*]] = fir.absent !fir.boxproc<() -> ()>102! CHECK: %[[undef:.*]] = fir.undefined index103! CHECK: %[[charLen:.*]] = fir.convert %[[undef]] : (index) -> i64104! CHECK: %[[tuple:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>105! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple]], %[[boxProc]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>106! CHECK: %[[tuple3:.*]] = fir.insert_value %[[tuple2]], %[[charLen]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>107! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple3]], %{{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()108 call use_char_proc(c=c)109! CHECK: %[[funcAddr:.*]] = fir.address_of(@_QMoptPchar_proc) : (!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>110! CHECK: %[[c3:.*]] = arith.constant 3 : i64111! CHECK: %[[boxProc2:.*]] = fir.emboxproc %[[funcAddr]] : ((!fir.ref<!fir.char<1,3>>, index, {{.*}}) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>112! CHECK: %[[tuple4:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>113! CHECK: %[[tuple5:.*]] = fir.insert_value %[[tuple4]], %[[boxProc2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>114! CHECK: %[[tuple6:.*]] = fir.insert_value %[[tuple5]], %[[c3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>115! CHECK: fir.call @_QMoptPuse_char_proc(%[[tuple6]], {{.*}}){{.*}} : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxchar<1>) -> ()116 call use_char_proc(char_proc, c)117end subroutine118 119! Test optional assumed shape120! CHECK-LABEL: func @_QMoptPassumed_shape(121! CHECK-SAME: %[[arg0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {122subroutine assumed_shape(x)123 real, optional :: x(:)124 ! CHECK: fir.is_present %[[arg0]] : (!fir.box<!fir.array<?xf32>>) -> i1125 print *, present(x)126end subroutine127! CHECK: func @_QMoptPcall_assumed_shape()128subroutine call_assumed_shape()129 ! CHECK: %[[addr:.*]] = fir.alloca !fir.array<100xf32>130 real :: x(100)131 ! CHECK: %[[embox:.*]] = fir.embox %[[addr]]132 ! CHECK: %[[x:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<100xf32>>) -> !fir.box<!fir.array<?xf32>>133 ! CHECK: fir.call @_QMoptPassumed_shape(%[[x]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()134 call assumed_shape(x)135 ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>136 ! CHECK: fir.call @_QMoptPassumed_shape(%[[absent]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()137 call assumed_shape()138end subroutine139 140! Test optional allocatable141! CHECK: func @_QMoptPallocatable_array(142! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "x", fir.optional}) {143subroutine allocatable_array(x)144 real, allocatable, optional :: x(:)145 ! CHECK: fir.is_present %[[arg0]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1146 print *, present(x)147end subroutine148! CHECK: func @_QMoptPcall_allocatable_array()149subroutine call_allocatable_array()150 ! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>>151 real, allocatable :: x(:)152 ! CHECK: fir.call @_QMoptPallocatable_array(%[[x]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()153 call allocatable_array(x)154 ! CHECK: %[[absent:.*]] = fir.absent !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>155 ! CHECK: fir.call @_QMoptPallocatable_array(%[[absent]]) {{.*}}: (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()156 call allocatable_array()157end subroutine158 159! CHECK: func @_QMoptPallocatable_to_assumed_optional_array(160! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>{{.*}}) {161subroutine allocatable_to_assumed_optional_array(x)162 real, allocatable :: x(:)163 164 ! CHECK: %[[xboxload:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>165 ! CHECK: %[[xptr:.*]] = fir.box_addr %[[xboxload]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>166 ! CHECK: %[[xaddr:.*]] = fir.convert %[[xptr]] : (!fir.heap<!fir.array<?xf32>>) -> i64167 ! CHECK: %[[isAlloc:.*]] = arith.cmpi ne, %[[xaddr]], %c0{{.*}} : i64168 ! CHECK: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>169 ! CHECK: %[[embox:.*]] = fir.embox %{{.*}}170 ! CHECK: %[[actual:.*]] = arith.select %[[isAlloc]], %[[embox]], %[[absent]] : !fir.box<!fir.array<?xf32>>171 ! CHECK: fir.call @_QMoptPassumed_shape(%[[actual]]) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()172 call assumed_shape(x)173end subroutine174 175! CHECK-LABEL: func @_QMoptPalloc_component_to_optional_assumed_shape(176subroutine alloc_component_to_optional_assumed_shape(x)177 type(t) :: x(100)178 ! CHECK-DAG: %[[isAlloc:.*]] = arith.cmpi ne179 ! CHECK-DAG: %[[absent:.*]] = fir.absent !fir.box<!fir.array<?xf32>>180 ! CHECK: %[[select:.*]] = arith.select %[[isAlloc]], %{{.*}}, %[[absent]] : !fir.box<!fir.array<?xf32>>181 ! CHECK: fir.call @_QMoptPassumed_shape(%[[select]])182 call assumed_shape(x(55)%p)183end subroutine184 185! CHECK-LABEL: func @_QMoptPalloc_component_eval_only_once(186subroutine alloc_component_eval_only_once(x)187 integer, external :: ifoo188 type(t) :: x(100)189 ! Verify that the index in the component reference are not evaluated twice190 ! because if the optional handling logic.191 ! CHECK: fir.call @_QPifoo()192 ! CHECK-NOT: fir.call @_QPifoo()193 call assumed_shape(x(ifoo())%p)194end subroutine195 196! CHECK-LABEL: func @_QMoptPnull_as_optional() {197subroutine null_as_optional198 ! CHECK: %[[null_ptr:.*]] = fir.alloca !fir.box<!fir.ptr<none>>199 ! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<none>200 ! CHECK: %[[null_box:.*]] = fir.embox %[[null]] : (!fir.ptr<none>) -> !fir.box<!fir.ptr<none>>201 ! CHECK: fir.store %[[null_box]] to %[[null_ptr]] : !fir.ref<!fir.box<!fir.ptr<none>>>202 ! CHECK: fir.call @_QMoptPassumed_shape(%{{.*}}) {{.*}}: (!fir.box<!fir.array<?xf32>>) -> ()203 call assumed_shape(null())204end subroutine null_as_optional205 206end module207