diff --git a/flang/test/Lower/call-by-value-attr.f90 b/flang/test/Lower/call-by-value-attr.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-by-value-attr.f90 @@ -0,0 +1,82 @@ +! Test for PassBy::BaseAddressValueAttribute +! RUN: bbc -emit-fir %s -o - | FileCheck %s +program call_by_value_attr + interface + subroutine subri(val) + integer, value :: val + end subroutine subri + subroutine subra(val) + integer, value, dimension(10) :: val + end subroutine subra + end interface + +!CHECK-LABEL: func @_QQmain() + integer :: v + integer, dimension(10) :: a + integer, dimension(15) :: b + v = 17 + call subri(v) + !CHECK: %[[COPY:.*]] = fir.alloca i32 + !CHECK: %[[ARRAY_A:.*]] = fir.address_of(@_QFEa) + !CHECK: %[[CONST_10_1:.*]] = arith.constant 10 : index + !CHECK: %[[ARRAY_B:.*]] = fir.address_of(@_QFEb) + !CHECK: %[[CONST_15_1:.*]] = arith.constant 15 : index + !CHECK: %[[VALUE:.*]] = fir.alloca i32 {bindc_name = "v", {{.*}}} + !CHECK: %[[CONST:.*]] = arith.constant 17 + !CHECK: fir.store %[[CONST]] to %[[VALUE]] + !CHECK: %[[LOAD:.*]] = fir.load %[[VALUE]] + !CHECK: fir.store %[[LOAD]] to %[[COPY]] + !CHECK: fir.call @_QPsubri(%[[COPY]]) : {{.*}} + a = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /) + !CHECK: %[[SHAPE_1:.*]] = fir.shape %[[CONST_10_1]] + !CHECK: %[[ARRAY_LOAD_1:.*]] = fir.array_load %[[ARRAY_A]](%[[SHAPE_1]]) : {{.*}} + !CHECK: %[[ARRAY_INIT_A:.*]] = fir.address_of({{.*}}) + !CHECK: %[[CONST_10_2:.*]] = arith.constant 10 : index + !CHECK: %[[SHAPE_2:.*]] = fir.shape %[[CONST_10_2]] + !CHECK: %[[ARRAY_LOAD_2:.*]] = fir.array_load %[[ARRAY_INIT_A]](%[[SHAPE_2]]) : {{.*}} + !CHECK: %[[DO_1:.*]] = fir.do_loop {{.*}} { + !CHECK: } + !CHECK: fir.array_merge_store %[[ARRAY_LOAD_1]], %[[DO_1]] to %[[ARRAY_A]] + !CHECK: %[[ARRAY_COPY:.*]] = fir.allocmem !fir.array<10xi32>, %[[CONST_10_1]] {uniq_name = ".copy"} + !CHECK: %[[SHAPE_3:.*]] = fir.shape %[[CONST_10_1]] + !CHECK: %[[ARRAY_LOAD_3:.*]] = fir.array_load %[[ARRAY_COPY]](%[[SHAPE_3]]) : {{.*}} + !CHECK: %[[SHAPE_4:.*]] = fir.shape %[[CONST_10_1]] + !CHECK: %[[ARRAY_LOAD_4:.*]] = fir.array_load %[[ARRAY_A]](%[[SHAPE_4]]) : {{.*}} + !CHECK: %[[DO_2:.*]] = fir.do_loop {{.*}} { + !CHECK: } + !CHECK: fir.array_merge_store %[[ARRAY_LOAD_3]], %[[DO_2]] to %[[ARRAY_COPY]] + !CHECK: %[[CONVERT:.*]] = fir.convert %[[ARRAY_COPY]] : (!fir.heap>) -> !fir.ref> + !CHECK: fir.call @_QPsubra(%[[CONVERT]]) + call subra(a) + b = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 /) + !CHECK: %[[SHAPE_5:.*]] = fir.shape %[[CONST_15_1]] + !CHECK: %[[ARRAY_LOAD_5:.*]] = fir.array_load %[[ARRAY_B]](%[[SHAPE_5]]) : {{.*}} + !CHECK: %[[ARRAY_INIT_B:.*]] = fir.address_of({{.*}}) + !CHECK: %[[CONST_15_2:.*]] = arith.constant 15 : index + !CHECK: %[[SHAPE_6:.*]] = fir.shape %[[CONST_15_2]] : (index) -> !fir.shape<1> + !CHECK: %[[ARRAY_LOAD_6:.*]] = fir.array_load %[[ARRAY_INIT_B]](%[[SHAPE_6]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<15xi32> + !CHECK: %[[DO_3:.*]] = fir.do_loop {{.*}} { + !CHECK: } + !CHECK: fir.array_merge_store %[[ARRAY_LOAD_5]], %[[DO_3]] to %[[ARRAY_B]] + !CHECK: %[[CONST_5:.*]] = arith.constant 5 : i64 + !CHECK: %[[CONV_5:.*]] = fir.convert %[[CONST_5]] : (i64) -> index + !CHECK: %[[CONST_1:.*]] = arith.constant 1 : i64 + !CHECK: %[[CONV_1:.*]] = fir.convert %[[CONST_1]] : (i64) -> index + !CHECK: %[[CONST_15_3:.*]] = arith.constant 15 : i64 + !CHECK: %[[CONV_15:.*]] = fir.convert %[[CONST_15_3]] : (i64) -> index + !CHECK: %[[SHAPE_7:.*]] = fir.shape %[[CONST_15_1]] : (index) -> !fir.shape<1> + !CHECK: %[[SLICE:.*]] = fir.slice %[[CONV_5]], %[[CONV_15]], %[[CONV_1]] : (index, index, index) -> !fir.slice<1> + !CHECK: %[[BOX:.*]] = fir.embox %[[ARRAY_B]](%[[SHAPE_7]]) [%[[SLICE]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> + !CHECK: %[[CONST_0:.*]] = arith.constant 0 : index + !CHECK: %[[DIMS:.*]]:3 = fir.box_dims %[[BOX]], %[[CONST_0]] : (!fir.box>, index) -> (index, index, index) + !CHECK: %[[ARRAY_COPY_2:.*]] = fir.allocmem !fir.array, %[[DIMS]]#1 {uniq_name = ".copy"} + !CHECK: %[[SHAPE_8:.*]] = fir.shape %[[DIMS]]#1 : (index) -> !fir.shape<1> + !CHECK: %[[ARRAY_LOAD_7:.*]] = fir.array_load %[[ARRAY_COPY_2]](%[[SHAPE_8]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array + !CHECK: %[[ARRAY_LOAD_8:.*]] = fir.array_load %[[BOX]] : (!fir.box>) -> !fir.array + !CHECK: %[[DO_4:.*]] = fir.do_loop {{.*}} { + !CHECK: } + !CHECK fir.array_merge_store %[[ARRAY_LOAD_7]], %[[DO_4]] to %[[ARRAY_COPY_2]] : !fir.array, !fir.array, !fir.heap> + !CHECK: %[[CONVERT_B:.*]] = fir.convert %[[ARRAY_COPY_2]] : (!fir.heap>) -> !fir.ref> + !CHECK: fir.call @_QPsubra(%[[CONVERT_B]]) + call subra(b(5:15)) +end program call_by_value_attr diff --git a/flang/test/Lower/call-by-value.f90 b/flang/test/Lower/call-by-value.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-by-value.f90 @@ -0,0 +1,20 @@ +! Test for PassBy::Value +! RUN: bbc -emit-fir %s -o - | FileCheck %s +program call_by_value + interface + subroutine omp_set_nested(enable) bind(c) + logical, value :: enable + end subroutine omp_set_nested + end interface + + logical do_nested + do_nested = .FALSE. + call omp_set_nested(do_nested) +end program call_by_value +!CHECK-LABEL: func @_QQmain() +!CHECK: %[[LOGICAL:.*]] = fir.alloca !fir.logical<4> +!CHECK: %false = arith.constant false +!CHECK: %[[VALUE:.*]] = fir.convert %false : (i1) -> !fir.logical<4> +!CHECK: fir.store %[[VALUE]] to %[[LOGICAL]] +!CHECK: %[[LOAD:.*]] = fir.load %[[LOGICAL]] +!CHECK: fir.call @omp_set_nested(%[[LOAD]]) : {{.*}} diff --git a/flang/test/Lower/call-copy-in-out.f90 b/flang/test/Lower/call-copy-in-out.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-copy-in-out.f90 @@ -0,0 +1,315 @@ +! Test copy-in / copy-out of non-contiguous variable passed as F77 array arguments. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Nominal test +! CHECK-LABEL: func @_QPtest_assumed_shape_to_array( +! CHECK-SAME: %[[x:.*]]: !fir.box>{{.*}}) { +subroutine test_assumed_shape_to_array(x) + real :: x(:) +! Creating temp +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x:.*]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 {uniq_name = ".copyinout"} + +! Copy-in +! CHECK-DAG: %[[shape:.*]] = fir.shape %[[dim]]#1 : (index) -> !fir.shape<1> +! CHECK-DAG: %[[temp_load:.*]] = fir.array_load %[[temp]](%[[shape]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK-DAG: %[[x_load:.*]] = fir.array_load %[[x]] : (!fir.box>) -> !fir.array +! CHECK: %[[copyin:.*]] = fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} step %{{.*}} iter_args(%[[res:.*]] = %[[temp_load]]) -> (!fir.array) { +! CHECK: %[[fetch:.*]] = fir.array_fetch %[[x_load]], %[[i]] : (!fir.array, index) -> f32 +! CHECK: %[[update:.*]] = fir.array_update %[[res]], %[[fetch]], %[[i]] : (!fir.array, f32, index) -> !fir.array +! CHECK: fir.result %[[update]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[temp_load]], %[[copyin:.*]] to %[[temp]] : !fir.array, !fir.array, !fir.heap> + +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () + +! Copy-out + +! CHECK-DAG: %[[x_load:.*]] = fir.array_load %[[x]] : (!fir.box>) -> !fir.array +! CHECK-DAG: %[[shape:.*]] = fir.shape %[[dim]]#1 : (index) -> !fir.shape<1> +! CHECK-DAG: %[[temp_load:.*]] = fir.array_load %[[temp]](%[[shape]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK: %[[copyout:.*]] = fir.do_loop %[[i:.*]] = %{{.*}} to %{{.*}} step %{{.*}} iter_args(%[[res:.*]] = %[[x_load]]) -> (!fir.array) { +! CHECK: %[[fetch:.*]] = fir.array_fetch %[[temp_load]], %[[i]] : (!fir.array, index) -> f32 +! CHECK: %[[update:.*]] = fir.array_update %[[res]], %[[fetch]], %[[i]] : (!fir.array, f32, index) -> !fir.array +! CHECK: fir.result %[[update]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[x_load]], %[[copyout:.*]] to %[[x]] : !fir.array, !fir.array, !fir.box> + +! CHECK: fir.freemem %[[temp]] + + call bar(x) +end subroutine + +! Test that copy-in/copy-out does not trigger the re-evaluation of +! the designator expression. +! CHECK-LABEL: func @_QPeval_expr_only_once( +! CHECK-SAME: %[[x:.*]]: !fir.ref>{{.*}}) { +subroutine eval_expr_only_once(x) + integer :: only_once + real :: x(200) +! CHECK: fir.call @_QPonly_once() +! CHECK: %[[x_section:.*]] = fir.embox %[[x]](%{{.*}}) [%{{.*}}] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array +! CHECK-NOT: fir.call @_QPonly_once() +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] +! CHECK-NOT: fir.call @_QPonly_once() + +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () + call bar(x(1:200:only_once())) + +! CHECK-NOT: fir.call @_QPonly_once() +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x_section]] +! CHECK-NOT: fir.call @_QPonly_once() +! CHECK: fir.freemem %[[temp]] +end subroutine + +! Test no copy-in/copy-out is generated for contiguous assumed shapes. +! CHECK-LABEL: func @_QPtest_contiguous( +! CHECK-SAME: %[[x:.*]]: !fir.box> +subroutine test_contiguous(x) + real, contiguous :: x(:) +! CHECK: %[[addr:.*]] = fir.box_addr %[[x]] : (!fir.box>) -> !fir.ref> +! CHECK-NOT: fir.array_merge_store +! CHECK: fir.call @_QPbar(%[[addr]]) : (!fir.ref>) -> () + call bar(x) +! CHECK-NOT: fir.array_merge_store +! CHECK: return +end subroutine + +! Test the parenthesis are preventing copy-out. +! CHECK: func @_QPtest_parenthesis( +! CHECK: %[[x:.*]]: !fir.box>{{.*}}) { +subroutine test_parenthesis(x) + real :: x(:) +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 {uniq_name = ".array.expr"} +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar(%[[cast]]) : (!fir.ref>) -> () + call bar((x)) +! CHECK-NOT: fir.array_merge_store +! CHECK: fir.freemem %[[temp]] +! CHECK: return +end subroutine + +! Test copy-in in is skipped for intent(out) arguments. +! CHECK: func @_QPtest_intent_out( +! CHECK: %[[x:.*]]: !fir.box>{{.*}}) { +subroutine test_intent_out(x) + real :: x(:) + interface + subroutine bar_intent_out(x) + real, intent(out) :: x(100) + end subroutine + end interface +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 +! CHECK-NOT: fir.array_merge_store +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar_intent_out(%[[cast]]) : (!fir.ref>) -> () + call bar_intent_out(x) +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] +! CHECK: fir.freemem %[[temp]] +! CHECK: return +end subroutine + +! Test copy-out is skipped for intent(out) arguments. +! CHECK: func @_QPtest_intent_in( +! CHECK: %[[x:.*]]: !fir.box>{{.*}}) { +subroutine test_intent_in(x) + real :: x(:) + interface + subroutine bar_intent_in(x) + real, intent(in) :: x(100) + end subroutine + end interface +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar_intent_in(%[[cast]]) : (!fir.ref>) -> () + call bar_intent_in(x) +! CHECK-NOT: fir.array_merge_store +! CHECK: fir.freemem %[[temp]] +! CHECK: return +end subroutine + +! Test copy-in/copy-out is done for intent(inout) +! CHECK: func @_QPtest_intent_inout( +! CHECK: %[[x:.*]]: !fir.box>{{.*}}) { +subroutine test_intent_inout(x) + real :: x(:) + interface + subroutine bar_intent_inout(x) + real, intent(inout) :: x(100) + end subroutine + end interface +! CHECK: %[[dim:.*]]:3 = fir.box_dims %[[x]], %c0{{.*}} : (!fir.box>, index) -> (index, index, index) +! CHECK: %[[temp:.*]] = fir.allocmem !fir.array, %[[dim]]#1 +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[temp]] +! CHECK: %[[cast:.*]] = fir.convert %[[temp]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar_intent_inout(%[[cast]]) : (!fir.ref>) -> () + call bar_intent_inout(x) +! CHECK: fir.array_merge_store %{{.*}}, %{{.*}} to %[[x]] +! CHECK: fir.freemem %[[temp]] +! CHECK: return +end subroutine + +! Test characters are handled correctly +! CHECK-LABEL: func @_QPtest_char( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>{{.*}}) { +subroutine test_char(x) + ! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_2]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_4:.*]] = fir.allocmem !fir.array>, %[[VAL_3]]#1 {uniq_name = ".copyinout"} + ! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_3]]#1 : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_6:.*]] = fir.array_load %[[VAL_4]](%[[VAL_5]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> + ! CHECK: %[[VAL_7:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>>) -> !fir.array> + ! CHECK: %[[VAL_8:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_10:.*]] = arith.subi %[[VAL_3]]#1, %[[VAL_8]] : index + ! CHECK: %[[VAL_11:.*]] = fir.do_loop %[[VAL_12:.*]] = %[[VAL_9]] to %[[VAL_10]] step %[[VAL_8]] unordered iter_args(%[[VAL_13:.*]] = %[[VAL_6]]) -> (!fir.array>) { + ! CHECK: %[[VAL_14:.*]] = fir.array_access %[[VAL_7]], %[[VAL_12]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_15:.*]] = fir.array_access %[[VAL_13]], %[[VAL_12]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_16:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_17:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (index) -> i64 + ! CHECK: %[[VAL_19:.*]] = arith.muli %[[VAL_17]], %[[VAL_18]] : i64 + ! CHECK: %[[VAL_20:.*]] = arith.constant false + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_15]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_14]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_21]], %[[VAL_22]], %[[VAL_19]], %[[VAL_20]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_23:.*]] = fir.array_amend %[[VAL_13]], %[[VAL_15]] : (!fir.array>, !fir.ref>) -> !fir.array> + ! CHECK: fir.result %[[VAL_23]] : !fir.array> + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_6]], %[[VAL_24:.*]] to %[[VAL_4]] : !fir.array>, !fir.array>, !fir.heap>> + ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_4]] : (!fir.heap>>) -> !fir.ref> + ! CHECK: %[[VAL_26:.*]] = fir.emboxchar %[[VAL_25]], %[[VAL_1]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPbar_char(%[[VAL_26]]) : (!fir.boxchar<1>) -> () + ! CHECK: %[[VAL_27:.*]] = fir.array_load %[[VAL_0]] : (!fir.box>>) -> !fir.array> + ! CHECK: %[[VAL_28:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_29:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_28]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_30:.*]] = fir.shape %[[VAL_3]]#1 : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_31:.*]] = fir.array_load %[[VAL_4]](%[[VAL_30]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> + ! CHECK: %[[VAL_32:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_33:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_34:.*]] = arith.subi %[[VAL_29]]#1, %[[VAL_32]] : index + ! CHECK: %[[VAL_35:.*]] = fir.do_loop %[[VAL_36:.*]] = %[[VAL_33]] to %[[VAL_34]] step %[[VAL_32]] unordered iter_args(%[[VAL_37:.*]] = %[[VAL_27]]) -> (!fir.array>) { + ! CHECK: %[[VAL_38:.*]] = fir.array_access %[[VAL_31]], %[[VAL_36]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_39:.*]] = fir.array_access %[[VAL_37]], %[[VAL_36]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_40:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_41:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_42:.*]] = fir.convert %[[VAL_40]] : (index) -> i64 + ! CHECK: %[[VAL_43:.*]] = arith.muli %[[VAL_41]], %[[VAL_42]] : i64 + ! CHECK: %[[VAL_44:.*]] = arith.constant false + ! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_39]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_38]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_45]], %[[VAL_46]], %[[VAL_43]], %[[VAL_44]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_47:.*]] = fir.array_amend %[[VAL_37]], %[[VAL_39]] : (!fir.array>, !fir.ref>) -> !fir.array> + ! CHECK: fir.result %[[VAL_47]] : !fir.array> + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_27]], %[[VAL_48:.*]] to %[[VAL_0]] : !fir.array>, !fir.array>, !fir.box>> + ! CHECK: fir.freemem %[[VAL_4]] + + character(10) :: x(:) + call bar_char(x) + ! CHECK: return + ! CHECK: } +end subroutine test_char + +! CHECK-LABEL: func @_QPtest_scalar_substring_does_no_trigger_copy_inout +! CHECK-SAME: %[[arg0:.*]]: !fir.boxchar<1> +subroutine test_scalar_substring_does_no_trigger_copy_inout(c, i, j) + character(*) :: c + integer :: i, j + ! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[arg0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[c:.*]] = fir.convert %[[unbox]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[c]], %{{.*}} : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: %[[substr:.*]] = fir.convert %[[coor]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[substr]], %{{.*}} : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPbar_char_2(%[[boxchar]]) : (!fir.boxchar<1>) -> () + call bar_char_2(c(i:j)) +end subroutine + +! CHECK-LABEL: func @_QPissue871( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>{{.*}}) +subroutine issue871(p) + ! Test passing implicit derived from scalar pointer (no copy-in/out). + type t + integer :: i + end type t + type(t), pointer :: p + ! CHECK: %[[box_load:.*]] = fir.load %[[p]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: fir.call @_QPbar_derived(%[[cast]]) + call bar_derived(p) +end subroutine + +! CHECK-LABEL: func @_QPissue871_array( +! CHECK-SAME: %[[p:.*]]: !fir.ref>>>> +subroutine issue871_array(p) + ! Test passing implicit derived from contiguous pointer (no copy-in/out). + type t + integer :: i + end type t + type(t), pointer, contiguous :: p(:) + ! CHECK: %[[box_load:.*]] = fir.load %[[p]] + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] + ! CHECK: fir.call @_QPbar_derived_array(%[[cast]]) + call bar_derived_array(p) +end subroutine + +! CHECK-LABEL: func @_QPwhole_components() +subroutine whole_components() + ! Test no copy is made for whole components. + type t + integer :: i(100) + end type + ! CHECK: %[[a:.*]] = fir.alloca !fir.type<_QFwhole_componentsTt{i:!fir.array<100xi32>}> + type(t) :: a + ! CHECK: %[[field:.*]] = fir.field_index i, !fir.type<_QFwhole_componentsTt{i:!fir.array<100xi32>}> + ! CHECK: %[[addr:.*]] = fir.coordinate_of %[[a]], %[[field]] : (!fir.ref}>>, !fir.field) -> !fir.ref> + ! CHECK: fir.call @_QPbar_integer(%[[addr]]) : (!fir.ref>) -> () + call bar_integer(a%i) +end subroutine + +! CHECK-LABEL: func @_QPwhole_component_contiguous_pointer() +subroutine whole_component_contiguous_pointer() + ! Test no copy is made for whole contiguous pointer components. + type t + integer, pointer, contiguous :: i(:) + end type + ! CHECK: %[[a:.*]] = fir.alloca !fir.type<_QFwhole_component_contiguous_pointerTt{i:!fir.box>>}> + type(t) :: a + ! CHECK: %[[field:.*]] = fir.field_index i, !fir.type<_QFwhole_component_contiguous_pointerTt{i:!fir.box>>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[a]], %[[field]] : (!fir.ref>>}>>, !fir.field) -> !fir.ref>>> + ! CHECK: %[[box_load:.*]] = fir.load %[[coor]] : !fir.ref>>> + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr>) -> !fir.ref> + ! CHECK: fir.call @_QPbar_integer(%[[cast]]) : (!fir.ref>) -> () + call bar_integer(a%i) +end subroutine + +! CHECK-LABEL: func @_QPwhole_component_contiguous_char_pointer() +subroutine whole_component_contiguous_char_pointer() + ! Test no copy is made for whole contiguous character pointer components. + type t + character(:), pointer, contiguous :: i(:) + end type + ! CHECK: %[[a:.*]] = fir.alloca !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box>>>}> + type(t) :: a + ! CHECK: %[[field:.*]] = fir.field_index i, !fir.type<_QFwhole_component_contiguous_char_pointerTt{i:!fir.box>>>}> + ! CHECK: %[[coor:.*]] = fir.coordinate_of %0, %1 : (!fir.ref>>>}>>, !fir.field) -> !fir.ref>>>> + ! CHECK: %[[box_load:.*]] = fir.load %[[coor]] : !fir.ref>>>> + ! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box>>>) -> !fir.ptr>> + ! CHECK: %[[len:.*]] = fir.box_elesize %[[box_load]] : (!fir.box>>>) -> index + ! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr>>) -> !fir.ref> + ! CHECK: %[[embox:.*]] = fir.emboxchar %[[cast]], %[[len]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPbar_char_3(%[[embox]]) : (!fir.boxchar<1>) -> () + call bar_char_3(a%i) +end subroutine diff --git a/flang/test/Lower/call-implicit.f90 b/flang/test/Lower/call-implicit.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-implicit.f90 @@ -0,0 +1,14 @@ +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s +! Test lowering of calls to procedures with implicit interfaces using different +! calls with different argument types, one of which is character +subroutine s2 + integer i(3) +! CHECK: %[[a0:.*]] = fir.alloca !fir.array<3xi32> {bindc_name = "i", uniq_name = "_QFs2Ei"} + ! CHECK: fir.call @_QPsub2(%[[a0]]) : (!fir.ref>) -> () + call sub2(i) +! CHECK: %[[a1:.*]] = fir.address_of(@_QQcl.3031323334) : !fir.ref> +! CHECK: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[a3:.*]] = fir.convert %[[a2]] : (!fir.ref>) -> !fir.ref> + ! CHECK: fir.call @_QPsub2(%[[a3]]) : (!fir.ref>) -> () + call sub2("01234") +end diff --git a/flang/test/Lower/call-parenthesized-arg.f90 b/flang/test/Lower/call-parenthesized-arg.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-parenthesized-arg.f90 @@ -0,0 +1,221 @@ +! Test that temps are always created of parenthesized arguments in +! calls. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPfoo_num_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref{{.*}}) { +subroutine foo_num_scalar(x) + integer :: x +! CHECK: %[[VAL_1:.*]] = fir.alloca i32 + call bar_num_scalar(x) +! CHECK: fir.call @_QPbar_num_scalar(%[[VAL_0]]) : (!fir.ref) -> () + call bar_num_scalar((x)) +! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.no_reassoc %[[VAL_2]] : i32 +! CHECK: fir.store %[[VAL_3]] to %[[VAL_1]] : !fir.ref +! CHECK: fir.call @_QPbar_num_scalar(%[[VAL_1]]) : (!fir.ref) -> () +! CHECK: return +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPfoo_char_scalar( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine foo_char_scalar(x) + character(5) :: x +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]] = arith.constant 5 : index +! CHECK: %[[VAL_3:.*]] = fir.emboxchar %[[VAL_1]]#0, %[[VAL_2]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPbar_char_scalar(%[[VAL_3]]) : (!fir.boxchar<1>) -> () + call bar_char_scalar(x) +! CHECK: %[[VAL_4:.*]] = fir.no_reassoc %[[VAL_1]]#0 : !fir.ref> +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.char<1,5> {bindc_name = ".chrtmp"} +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_2]] : (index) -> i64 +! CHECK: %[[VAL_8:.*]] = arith.muli %[[VAL_6]], %[[VAL_7]] : i64 +! CHECK: %[[VAL_9:.*]] = arith.constant false +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> !fir.ref +! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_10]], %[[VAL_11]], %[[VAL_8]], %[[VAL_9]]) : (!fir.ref, !fir.ref, i64, i1) -> () +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_5]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_2]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPbar_char_scalar(%[[VAL_13]]) : (!fir.boxchar<1>) -> () +! CHECK: return +! CHECK: } + call bar_char_scalar((x)) +end subroutine + +! CHECK-LABEL: func @_QPfoo_num_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>{{.*}}) { +subroutine foo_num_array(x) + integer :: x(100) + call bar_num_array(x) +! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index +! CHECK: fir.call @_QPbar_num_array(%[[VAL_0]]) : (!fir.ref>) -> () + call bar_num_array((x)) +! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index +! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_5:.*]] = fir.array_load %[[VAL_0]](%[[VAL_4]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xi32> +! CHECK: %[[VAL_6:.*]] = fir.allocmem !fir.array<100xi32> +! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_6]](%[[VAL_7]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array<100xi32> +! CHECK: %[[VAL_9:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_3]], %[[VAL_9]] : index +! CHECK: %[[VAL_12:.*]] = fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_11]] step %[[VAL_9]] unordered iter_args(%[[VAL_14:.*]] = %[[VAL_8]]) -> (!fir.array<100xi32>) { +! CHECK: %[[VAL_15:.*]] = fir.array_fetch %[[VAL_5]], %[[VAL_13]] : (!fir.array<100xi32>, index) -> i32 +! CHECK: %[[VAL_16:.*]] = fir.no_reassoc %[[VAL_15]] : i32 +! CHECK: %[[VAL_17:.*]] = fir.array_update %[[VAL_14]], %[[VAL_16]], %[[VAL_13]] : (!fir.array<100xi32>, i32, index) -> !fir.array<100xi32> +! CHECK: fir.result %[[VAL_17]] : !fir.array<100xi32> +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_8]], %[[VAL_18:.*]] to %[[VAL_6]] : !fir.array<100xi32>, !fir.array<100xi32>, !fir.heap> +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_6]] : (!fir.heap>) -> !fir.ref> +! CHECK: fir.call @_QPbar_num_array(%[[VAL_19]]) : (!fir.ref>) -> () +! CHECK: fir.freemem %[[VAL_6]] +! CHECK: return +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPfoo_char_array( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine foo_char_array(x) + ! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_3]] : (!fir.ref>>) -> !fir.ref> + ! CHECK: %[[VAL_6:.*]] = fir.emboxchar %[[VAL_5]], %[[VAL_2]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPbar_char_array(%[[VAL_6]]) : (!fir.boxchar<1>) -> () + ! CHECK: %[[VAL_8:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_10:.*]] = fir.array_load %[[VAL_3]](%[[VAL_9]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array<100x!fir.char<1,10>> + ! CHECK: %[[VAL_11:.*]] = fir.allocmem !fir.array<100x!fir.char<1,10>> + ! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_13:.*]] = fir.array_load %[[VAL_11]](%[[VAL_12]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array<100x!fir.char<1,10>> + ! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_15:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_16:.*]] = arith.subi %[[VAL_8]], %[[VAL_14]] : index + ! CHECK: %[[VAL_17:.*]] = fir.do_loop %[[VAL_18:.*]] = %[[VAL_15]] to %[[VAL_16]] step %[[VAL_14]] unordered iter_args(%[[VAL_19:.*]] = %[[VAL_13]]) -> (!fir.array<100x!fir.char<1,10>>) { + ! CHECK: %[[VAL_20:.*]] = fir.array_access %[[VAL_10]], %[[VAL_18]] : (!fir.array<100x!fir.char<1,10>>, index) -> !fir.ref> + ! CHECK: %[[VAL_21:.*]] = fir.no_reassoc %[[VAL_20]] : !fir.ref> + ! CHECK: %[[VAL_22:.*]] = fir.array_access %[[VAL_19]], %[[VAL_18]] : (!fir.array<100x!fir.char<1,10>>, index) -> !fir.ref> + ! CHECK: %[[VAL_23:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_24:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_23]] : (index) -> i64 + ! CHECK: %[[VAL_26:.*]] = arith.muli %[[VAL_24]], %[[VAL_25]] : i64 + ! CHECK: %[[VAL_27:.*]] = arith.constant false + ! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_22]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_21]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_28]], %[[VAL_29]], %[[VAL_26]], %[[VAL_27]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_30:.*]] = fir.array_amend %[[VAL_19]], %[[VAL_22]] : (!fir.array<100x!fir.char<1,10>>, !fir.ref>) -> !fir.array<100x!fir.char<1,10>> + ! CHECK: fir.result %[[VAL_30]] : !fir.array<100x!fir.char<1,10>> + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_13]], %[[VAL_31:.*]] to %[[VAL_11]] : !fir.array<100x!fir.char<1,10>>, !fir.array<100x!fir.char<1,10>>, !fir.heap>> + ! CHECK: %[[VAL_32:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_11]] : (!fir.heap>>) -> !fir.ref> + ! CHECK: %[[VAL_34:.*]] = fir.emboxchar %[[VAL_33]], %[[VAL_32]] : (!fir.ref>, index) -> !fir.boxchar<1> + ! CHECK: fir.call @_QPbar_char_array(%[[VAL_34]]) : (!fir.boxchar<1>) -> () + ! CHECK: fir.freemem %[[VAL_11]] + + character(10) :: x(100) + call bar_char_array(x) + call bar_char_array((x)) + ! CHECK: return + ! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPfoo_num_array_box( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>{{.*}}) { +subroutine foo_num_array_box(x) + ! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_0]](%[[VAL_2]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + ! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.box>) -> !fir.box> + ! CHECK: fir.call @_QPbar_num_array_box(%[[VAL_4]]) : (!fir.box>) -> () + ! CHECK: %[[VAL_6:.*]] = arith.constant 100 : index + ! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_8:.*]] = fir.array_load %[[VAL_0]](%[[VAL_7]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<100xi32> + ! CHECK: %[[VAL_9:.*]] = fir.allocmem !fir.array<100xi32> + ! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_11:.*]] = fir.array_load %[[VAL_9]](%[[VAL_10]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array<100xi32> + ! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_6]], %[[VAL_12]] : index + ! CHECK: %[[VAL_15:.*]] = fir.do_loop %[[VAL_16:.*]] = %[[VAL_13]] to %[[VAL_14]] step %[[VAL_12]] unordered iter_args(%[[VAL_17:.*]] = %[[VAL_11]]) -> (!fir.array<100xi32>) { + ! CHECK: %[[VAL_18:.*]] = fir.array_fetch %[[VAL_8]], %[[VAL_16]] : (!fir.array<100xi32>, index) -> i32 + ! CHECK: %[[VAL_19:.*]] = fir.no_reassoc %[[VAL_18]] : i32 + ! CHECK: %[[VAL_20:.*]] = fir.array_update %[[VAL_17]], %[[VAL_19]], %[[VAL_16]] : (!fir.array<100xi32>, i32, index) -> !fir.array<100xi32> + ! CHECK: fir.result %[[VAL_20]] : !fir.array<100xi32> + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_11]], %[[VAL_21:.*]] to %[[VAL_9]] : !fir.array<100xi32>, !fir.array<100xi32>, !fir.heap> + ! CHECK: %[[VAL_22:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_23:.*]] = fir.embox %[[VAL_9]](%[[VAL_22]]) : (!fir.heap>, !fir.shape<1>) -> !fir.box> + ! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.box>) -> !fir.box> + ! CHECK: fir.call @_QPbar_num_array_box(%[[VAL_24]]) : (!fir.box>) -> () + ! CHECK: fir.freemem %[[VAL_9]] + + integer :: x(100) + interface + subroutine bar_num_array_box(x) + integer :: x(:) + end subroutine + end interface + call bar_num_array_box(x) + call bar_num_array_box((x)) +! CHECK: return +! CHECK: } +end subroutine + +! CHECK-LABEL: func @_QPfoo_char_array_box( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_1:.*]]: !fir.ref{{.*}}) { +subroutine foo_char_array_box(x, n) + ! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_1]] : !fir.ref + ! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> i64 + ! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index + ! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_3]](%[[VAL_7]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + ! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box>>) -> !fir.box>> + ! CHECK: fir.call @_QPbar_char_array_box(%[[VAL_9]]) : (!fir.box>>) -> () + ! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_11:.*]] = fir.array_load %[[VAL_3]](%[[VAL_10]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.array> + ! CHECK: %[[VAL_12:.*]] = fir.allocmem !fir.array>, %[[VAL_6]] {uniq_name = ".array.expr"} + ! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_14:.*]] = fir.array_load %[[VAL_12]](%[[VAL_13]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.array> + ! CHECK: %[[VAL_15:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_16:.*]] = arith.constant 0 : index + ! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_6]], %[[VAL_15]] : index + ! CHECK: %[[VAL_18:.*]] = fir.do_loop %[[VAL_19:.*]] = %[[VAL_16]] to %[[VAL_17]] step %[[VAL_15]] unordered iter_args(%[[VAL_20:.*]] = %[[VAL_14]]) -> (!fir.array>) { + ! CHECK: %[[VAL_21:.*]] = fir.array_access %[[VAL_11]], %[[VAL_19]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_22:.*]] = fir.no_reassoc %[[VAL_21]] : !fir.ref> + ! CHECK: %[[VAL_23:.*]] = fir.array_access %[[VAL_20]], %[[VAL_19]] : (!fir.array>, index) -> !fir.ref> + ! CHECK: %[[VAL_24:.*]] = arith.constant 10 : index + ! CHECK: %[[VAL_25:.*]] = arith.constant 1 : i64 + ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_24]] : (index) -> i64 + ! CHECK: %[[VAL_27:.*]] = arith.muli %[[VAL_25]], %[[VAL_26]] : i64 + ! CHECK: %[[VAL_28:.*]] = arith.constant false + ! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_23]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_30:.*]] = fir.convert %[[VAL_22]] : (!fir.ref>) -> !fir.ref + ! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[VAL_29]], %[[VAL_30]], %[[VAL_27]], %[[VAL_28]]) : (!fir.ref, !fir.ref, i64, i1) -> () + ! CHECK: %[[VAL_31:.*]] = fir.array_amend %[[VAL_20]], %[[VAL_23]] : (!fir.array>, !fir.ref>) -> !fir.array> + ! CHECK: fir.result %[[VAL_31]] : !fir.array> + ! CHECK: } + ! CHECK: fir.array_merge_store %[[VAL_14]], %[[VAL_32:.*]] to %[[VAL_12]] : !fir.array>, !fir.array>, !fir.heap>> + ! CHECK: %[[VAL_33:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_34:.*]] = fir.embox %[[VAL_12]](%[[VAL_33]]) : (!fir.heap>>, !fir.shape<1>) -> !fir.box>> + ! CHECK: %[[VAL_35:.*]] = fir.convert %[[VAL_34]] : (!fir.box>>) -> !fir.box>> + ! CHECK: fir.call @_QPbar_char_array_box(%[[VAL_35]]) : (!fir.box>>) -> () + ! CHECK: fir.freemem %[[VAL_12]] + + integer :: n + character(10) :: x(n) + interface + subroutine bar_char_array_box(x) + character(*) :: x(:) + end subroutine + end interface + call bar_char_array_box(x) + call bar_char_array_box((x)) + ! CHECK: return + ! CHECK: } +end subroutine diff --git a/flang/test/Lower/call-site-mangling.f90 b/flang/test/Lower/call-site-mangling.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-site-mangling.f90 @@ -0,0 +1,106 @@ +! RUN: bbc %s -o "-" -emit-fir | FileCheck %s + +subroutine sub() + real :: x + ! CHECK: fir.call @_QPasubroutine() + call AsUbRoUtInE(); + ! CHECK: fir.call @_QPfoo() + x = foo() +end subroutine + +module testMod +contains + subroutine sub() + end subroutine + + function foo() + end function +end module + +subroutine sub1() + use testMod + real :: x + ! CHECK: fir.call @_QMtestmodPsub() + call Sub(); + ! CHECK: fir.call @_QMtestmodPfoo() + x = foo() +end subroutine + +subroutine sub2() + use testMod, localfoo => foo, localsub => sub + real :: x + ! CHECK: fir.call @_QMtestmodPsub() + call localsub(); + ! CHECK: fir.call @_QMtestmodPfoo() + x = localfoo() +end subroutine + + + +subroutine sub3() + real :: x + ! CHECK: fir.call @_QFsub3Psub() + call sub(); + ! CHECK: fir.call @_QFsub3Pfoo() + x = foo() +contains + subroutine sub() + end subroutine + + function foo() + end function +end subroutine + +function foo1() + real :: bar1 + ! CHECK: fir.call @_QPbar1() + foo1 = bar1() +end function + +function foo2() + ! CHECK: fir.call @_QPbar2() + foo2 = bar2() +end function + +function foo3() + interface + real function bar3() + end function + end interface + ! CHECK: fir.call @_QPbar3() + foo3 = bar3() +end function + +function foo4() + external :: bar4 + ! CHECK: fir.call @_QPbar4() + foo4 = bar4() +end function + +module test_bindmodule + contains + ! CHECK: func @modulecproc() + ! CHECK: func @bind_modulecproc() + subroutine modulecproc() bind(c) + end subroutine + subroutine modulecproc_1() bind(c, name="bind_modulecproc") + end subroutine +end module +! CHECK-LABEL: func @_QPtest_bindmodule_call() { +subroutine test_bindmodule_call + use test_bindmodule + interface + subroutine somecproc() bind(c) + end subroutine + subroutine somecproc_1() bind(c, name="bind_somecproc") + end subroutine + end interface + ! CHECK: fir.call @modulecproc() + ! CHECK: fir.call @bind_modulecproc() + ! CHECK: fir.call @somecproc() + ! CHECK: fir.call @bind_somecproc() + call modulecproc() + call modulecproc_1() + call somecproc() + call somecproc_1() +end subroutine diff --git a/flang/test/Lower/call-suspect.f90 b/flang/test/Lower/call-suspect.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call-suspect.f90 @@ -0,0 +1,35 @@ +! Note: flang will issue warnings for the following subroutines. These +! are accepted regardless to maintain backwards compatibility with +! other Fortran implementations. + +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPs1() { +! CHECK: %[[cast:.*]] = fir.convert %{{.*}} : (!fir.ref) -> !fir.ref> +! CHECK: %[[undef:.*]] = fir.undefined index +! CHECK: %[[box:.*]] = fir.emboxchar %[[cast]], %[[undef]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPs3(%[[box]]) : (!fir.boxchar<1>) -> () + +! Pass a REAL by reference to a subroutine expecting a CHARACTER +subroutine s1 + call s3(r) +end subroutine s1 + +! CHECK-LABEL: func @_QPs2( +! CHECK: %[[ptr:.*]] = fir.box_addr %{{.*}} : (!fir.box>) -> !fir.ptr +! CHECK: %[[cast:.*]] = fir.convert %[[ptr]] : (!fir.ptr) -> !fir.ref> +! CHECK: %[[undef:.*]] = fir.undefined index +! CHECK: %[[box:.*]] = fir.emboxchar %[[cast]], %[[undef]] : (!fir.ref>, index) -> !fir.boxchar<1> +! CHECK: fir.call @_QPs3(%[[box]]) : (!fir.boxchar<1>) -> () + +! Pass a REAL, POINTER data reference to a subroutine expecting a CHARACTER +subroutine s2(p) + real, pointer :: p + call s3(p) +end subroutine s2 + +! CHECK-LABEL: func @_QPs3( +! CHECK-SAME: !fir.boxchar<1> +subroutine s3(c) + character(8) c +end subroutine s3 diff --git a/flang/test/Lower/call.f90 b/flang/test/Lower/call.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/call.f90 @@ -0,0 +1,20 @@ +! Test various aspects around call lowering. More detailed tests around core +! requirements are done in call-xxx.f90 and dummy-argument-xxx.f90 files. + +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPtest_nested_calls +subroutine test_nested_calls() + interface + subroutine foo(i) + integer :: i + end subroutine + integer function bar() + end function + end interface + ! CHECK: %[[result_storage:.*]] = fir.alloca i32 {adapt.valuebyref} + ! CHECK: %[[result:.*]] = fir.call @_QPbar() : () -> i32 + ! CHECK: fir.store %[[result]] to %[[result_storage]] : !fir.ref + ! CHECK: fir.call @_QPfoo(%[[result_storage]]) : (!fir.ref) -> () + call foo(bar()) +end subroutine