diff --git a/flang/test/Lower/complex-part.f90 b/flang/test/Lower/complex-part.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/complex-part.f90 @@ -0,0 +1,11 @@ +! RUN: bbc %s -o - | tco | FileCheck %s + + COMPLEX c + c%RE = 3.14 + CALL sub(c) +END + +! Verify that the offset in the struct does not regress from i32. +! CHECK-LABEL: define void @_QQmain() +! CHECK: getelementptr { float, float }, { float, float }* %{{[0-9]+}}, i64 0, i32 0 + diff --git a/flang/test/Lower/computed-goto.f90 b/flang/test/Lower/computed-goto.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/computed-goto.f90 @@ -0,0 +1,18 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPm +function m(index) + ! CHECK: fir.select %{{.}} : i32 [1, ^bb{{.}}, 2, ^bb{{.}}, 3, ^bb{{.}}, 4, ^bb{{.}}, 5, ^bb{{.}}, unit, ^bb{{.}}] + goto (9,7,5,3,1) index ! + 1 + m = 0; return +1 m = 1; return +3 m = 3; return +5 m = 5; return +7 m = 7; return +9 m = 9; return +end + +! print*, m(-3); print*, m(0) +! print*, m(1); print*, m(2); print*, m(3); print*, m(4); print*, m(5) +! print*, m(6); print*, m(9) +end diff --git a/flang/test/Lower/control-flow.f90 b/flang/test/Lower/control-flow.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/control-flow.f90 @@ -0,0 +1,25 @@ +! Tests for control-flow + +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! check the lowering of a RETURN in the body of a SUBROUTINE +! CHECK-LABEL one +subroutine one(a,b,c) + d = 1.0 + if (a .ne. b) then + ! CHECK: call @_QPone_a + call one_a(d) + ! CHECK: cond_br %{{.*}}, ^bb[[TB:.*]], ^ + if (d .eq. 1.0) then + ! CHECK-NEXT: ^bb[[TB]]: + ! CHECK-NEXT: br ^bb[[EXIT:.*]] + return + endif + else + e = 4.0 + call one_b(c,d,e) + endif + ! CHECK: ^bb[[EXIT]]: + ! CHECK-NEXT: return +end subroutine one + diff --git a/flang/test/Lower/default-initialization.f90 b/flang/test/Lower/default-initialization.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/default-initialization.f90 @@ -0,0 +1,177 @@ +! Test default initialization of local and dummy variables (dynamic initialization) +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +module test_dinit + type t + integer :: i = 42 + end type + type t_alloc_comp + real, allocatable :: i(:) + end type + type tseq + sequence + integer :: i = 42 + end type +contains + +! ----------------------------------------------------------------------------- +! Test default initialization of local and dummy variables. +! ----------------------------------------------------------------------------- + + ! Test local scalar is default initialized + ! CHECK-LABEL: func @_QMtest_dinitPlocal() + subroutine local + ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + type(t) :: x + print *, x%i + end subroutine + + ! Test local array is default initialized + ! CHECK-LABEL: func @_QMtest_dinitPlocal_array() + subroutine local_array() + ! CHECK: %[[x:.*]] = fir.alloca !fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>> + ! CHECK: %[[xshape:.*]] = fir.shape %c4{{.*}} : (index) -> !fir.shape<1> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshape]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + type(t) :: x(4) + print *, x(2)%i + end subroutine + + ! Test allocatable component triggers default initialization of local + ! scalars. + ! CHECK-LABEL: func @_QMtest_dinitPlocal_alloc_comp() + subroutine local_alloc_comp + ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box>>}> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref>>}>>) -> !fir.box>>}>> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + type(t_alloc_comp) :: x + end subroutine + + ! Test function results are default initialized. + ! CHECK-LABEL: func @_QMtest_dinitPresult() -> !fir.type<_QMtest_dinitTt{i:i32}> + function result() + ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + type(t) :: result + end function + + ! Test intent(out) dummies are default initialized + ! CHECK-LABEL: func @_QMtest_dinitPintent_out( + ! CHECK-SAME: %[[x:.*]]: !fir.ref> + subroutine intent_out(x) + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + type(t), intent(out) :: x + end subroutine + + ! Test that optional intent(out) are default initialized only when + ! present. + ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional( + ! CHECK-SAME: %[[x:.*]]: !fir.box> {fir.bindc_name = "x", fir.optional}) + subroutine intent_out_optional(x) + ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.box>) -> i1 + ! CHECK: fir.if %[[isPresent]] { + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[x]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + ! CHECK: } + type(t), intent(out), optional :: x + end subroutine + + ! Test local equivalences where one entity has default initialization + ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq() + subroutine local_eq() + type(tseq) :: x + integer :: zi + ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8> + ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref) -> !fir.ptr> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr>) -> !fir.box> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + equivalence (x, zi) + print *, i + end subroutine + + ! Test local equivalences with both equivalenced entities being + ! default initialized. Note that the standard allow default initialization + ! to be performed several times as long as the values are the same. So + ! far that is what lowering is doing to stay simple. + ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq2() + subroutine local_eq2() + type(tseq) :: x + type(tseq) :: y + ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8> + ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref) -> !fir.ptr> + ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr>) -> !fir.box> + ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]] + ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + + + ! CHECK: %[[ycoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[y:.*]] = fir.convert %[[ycoor]] : (!fir.ref) -> !fir.ptr> + ! CHECK: %[[ybox:.*]] = fir.embox %[[y]] : (!fir.ptr>) -> !fir.box> + ! CHECK: %[[yboxNone:.*]] = fir.convert %[[ybox]] + ! CHECK: fir.call @_FortranAInitialize(%[[yboxNone]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none + equivalence (x, y) + print *, y%i + end subroutine + + +! ----------------------------------------------------------------------------- +! Test for local and dummy variables that must not be initialized +! ----------------------------------------------------------------------------- + + ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_alloc + subroutine noinit_local_alloc + ! CHECK-NOT: fir.call @_FortranAInitialize + type(t), allocatable :: x + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_pointer + subroutine noinit_local_pointer + ! CHECK-NOT: fir.call @_FortranAInitialize + type(t), pointer :: x + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QMtest_dinitPnoinit_normal_dummy + subroutine noinit_normal_dummy(x) + ! CHECK-NOT: fir.call @_FortranAInitialize + type(t) :: x + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QMtest_dinitPnoinit_intentinout_dummy + subroutine noinit_intentinout_dummy(x) + ! CHECK-NOT: fir.call @_FortranAInitialize + type(t), intent(inout) :: x + ! CHECK: return + end subroutine + +end module + +! End-to-end test for debug pruposes. + use test_dinit + type(t) :: at + call local() + call local_array() + at%i = 66 + call intent_out(at) + print *, at%i + at%i = 66 + call intent_out_optional(at) + print *, at%i + call intent_out_optional() + call local_eq() + call local_eq2() +end diff --git a/flang/test/Lower/dense-attributed-array.f90 b/flang/test/Lower/dense-attributed-array.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/dense-attributed-array.f90 @@ -0,0 +1,22 @@ +! RUN: bbc --emit-fir %s -o - | FileCheck %s + +! Test generation of dense attributed global array. Also, make sure there are +! no dead ssa assignments. +module mm + integer, parameter :: qq(3) = [(i,i=51,53)] +end +subroutine ss + use mm + n = qq(3) +end +!CHECK-NOT: %{{.*}} = fir.undefined !fir.array<3xi32> +!CHECK-NOT: %{{.*}} = arith.constant %{{.*}} : index +!CHECK-NOT: %{{.*}} = arith.constant %{{.*}} : i32 +!CHECK-NOT: %{{.*}} = fir.insert_value %{{.*}}, %{{.*}}, [%{{.*}} : index] : (!fir.array<3xi32>, i32) -> !fir.array<3xi32> +!CHECK: fir.global @_QMmmECqq(dense<[51, 52, 53]> : tensor<3xi32>) constant : !fir.array<3xi32> +!CHECK: func @_QPss() { +!CHECK: %[[a0:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFssEn"} +!CHECK: %[[c0:.*]] = arith.constant 53 : i32 +!CHECK: fir.store %[[c0]] to %[[a0]] : !fir.ref +!CHECK: return +!CHECK: } diff --git a/flang/test/Lower/identical-block-merge-disable.f90 b/flang/test/Lower/identical-block-merge-disable.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/identical-block-merge-disable.f90 @@ -0,0 +1,139 @@ +! Test disable identical block merge in the canonicalizer pass in bbc. +! Temporary fix for issue #1021. +! RUN: bbc %s -o - | FileCheck %s + +MODULE DMUMPS_SOL_LR +IMPLICIT NONE + +TYPE BLR_STRUC_T + INTEGER, DIMENSION(:), POINTER :: PANELS_L + INTEGER, DIMENSION(:), POINTER :: PANELS_U + INTEGER, DIMENSION(:), POINTER :: BEGS_BLR_STATIC +END TYPE BLR_STRUC_T + +TYPE(BLR_STRUC_T), POINTER, DIMENSION(:), SAVE :: BLR_ARRAY + +CONTAINS + +SUBROUTINE DMUMPS_SOL_FWD_LR_SU( IWHDLR, MTYPE ) + + INTEGER, INTENT(IN) :: IWHDLR, MTYPE + INTEGER :: NPARTSASS, NB_BLR + + IF (MTYPE.EQ.1) THEN + IF ( associated( BLR_ARRAY(IWHDLR)%PANELS_L ) ) THEN + NPARTSASS = size( BLR_ARRAY(IWHDLR)%PANELS_L ) + NB_BLR = size( BLR_ARRAY(IWHDLR)%BEGS_BLR_STATIC ) - 1 + ENDIF + ELSE + IF ( associated( BLR_ARRAY(IWHDLR)%PANELS_U ) ) THEN + NPARTSASS = size( BLR_ARRAY(IWHDLR)%PANELS_U ) + NB_BLR = size( BLR_ARRAY(IWHDLR)%BEGS_BLR_STATIC ) - 1 + ENDIF + ENDIF + +END SUBROUTINE DMUMPS_SOL_FWD_LR_SU + +END MODULE DMUMPS_SOL_LR + +! CHECK-LABEL: func @_QMdmumps_sol_lrPdmumps_sol_fwd_lr_su( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref{{.*}}, %[[VAL_1:.*]]: !fir.ref{{.*}}) { +! CHECK-DAG: %[[VAL_2:.*]] = arith.constant 0 : i64 +! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 0 : index +! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 1 : i32 +! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QMdmumps_sol_lrEblr_array) : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_6:.*]] = fir.alloca i32 {bindc_name = "nb_blr", uniq_name = "_QMdmumps_sol_lrFdmumps_sol_fwd_lr_suEnb_blr"} +! CHECK: %[[VAL_7:.*]] = fir.alloca i32 {bindc_name = "npartsass", uniq_name = "_QMdmumps_sol_lrFdmumps_sol_fwd_lr_suEnpartsass"} +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref +! CHECK: %[[VAL_9:.*]] = arith.cmpi eq, %[[VAL_8]], %[[VAL_4]] : i32 +! CHECK: cond_br %[[VAL_9]], ^bb1, ^bb3 +! CHECK: ^bb1: +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_10]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> i64 +! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_11]]#0 : (index) -> i64 +! CHECK: %[[VAL_15:.*]] = arith.subi %[[VAL_13]], %[[VAL_14]] : i64 +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_10]], %[[VAL_15]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_17:.*]] = fir.field_index panels_l, !fir.type<_QMdmumps_sol_lrTblr_struc_t{panels_l:!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}> +! CHECK: %[[VAL_18:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_17]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_18]] : !fir.ref>>> +! CHECK: %[[VAL_20:.*]] = fir.box_addr %[[VAL_19]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (!fir.ptr>) -> i64 +! CHECK: %[[VAL_22:.*]] = arith.cmpi ne, %[[VAL_21]], %[[VAL_2]] : i64 +! CHECK: cond_br %[[VAL_22]], ^bb2, ^bb5 +! CHECK: ^bb2: +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_24:.*]]:3 = fir.box_dims %[[VAL_23]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64 +! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_24]]#0 : (index) -> i64 +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_26]], %[[VAL_27]] : i64 +! CHECK: %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_23]], %[[VAL_28]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_30:.*]] = fir.coordinate_of %[[VAL_29]], %[[VAL_17]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_31:.*]] = fir.load %[[VAL_30]] : !fir.ref>>> +! CHECK: %[[VAL_32:.*]]:3 = fir.box_dims %[[VAL_31]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]]#1 : (index) -> i32 +! CHECK: fir.store %[[VAL_33]] to %[[VAL_7]] : !fir.ref +! CHECK: %[[VAL_34:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_35:.*]]:3 = fir.box_dims %[[VAL_34]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_36:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_37:.*]] = fir.convert %[[VAL_36]] : (i32) -> i64 +! CHECK: %[[VAL_38:.*]] = fir.convert %[[VAL_35]]#0 : (index) -> i64 +! CHECK: %[[VAL_39:.*]] = arith.subi %[[VAL_37]], %[[VAL_38]] : i64 +! CHECK: %[[VAL_40:.*]] = fir.coordinate_of %[[VAL_34]], %[[VAL_39]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_41:.*]] = fir.field_index begs_blr_static, !fir.type<_QMdmumps_sol_lrTblr_struc_t{panels_l:!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}> +! CHECK: %[[VAL_42:.*]] = fir.coordinate_of %[[VAL_40]], %[[VAL_41]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_43:.*]] = fir.load %[[VAL_42]] : !fir.ref>>> +! CHECK: %[[VAL_44:.*]]:3 = fir.box_dims %[[VAL_43]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_45:.*]] = fir.convert %[[VAL_44]]#1 : (index) -> i32 +! CHECK: %[[VAL_46:.*]] = arith.subi %[[VAL_45]], %[[VAL_4]] : i32 +! CHECK: fir.store %[[VAL_46]] to %[[VAL_6]] : !fir.ref +! CHECK: br ^bb5 +! CHECK: ^bb3: +! CHECK: %[[VAL_47:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_48:.*]]:3 = fir.box_dims %[[VAL_47]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_49:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_50:.*]] = fir.convert %[[VAL_49]] : (i32) -> i64 +! CHECK: %[[VAL_51:.*]] = fir.convert %[[VAL_48]]#0 : (index) -> i64 +! CHECK: %[[VAL_52:.*]] = arith.subi %[[VAL_50]], %[[VAL_51]] : i64 +! CHECK: %[[VAL_53:.*]] = fir.coordinate_of %[[VAL_47]], %[[VAL_52]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_54:.*]] = fir.field_index panels_u, !fir.type<_QMdmumps_sol_lrTblr_struc_t{panels_l:!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}> +! CHECK: %[[VAL_55:.*]] = fir.coordinate_of %[[VAL_53]], %[[VAL_54]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_56:.*]] = fir.load %[[VAL_55]] : !fir.ref>>> +! CHECK: %[[VAL_57:.*]] = fir.box_addr %[[VAL_56]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_58:.*]] = fir.convert %[[VAL_57]] : (!fir.ptr>) -> i64 +! CHECK: %[[VAL_59:.*]] = arith.cmpi ne, %[[VAL_58]], %[[VAL_2]] : i64 +! CHECK: cond_br %[[VAL_59]], ^bb4, ^bb5 +! CHECK: ^bb4: +! CHECK: %[[VAL_60:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_61:.*]]:3 = fir.box_dims %[[VAL_60]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_62:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_63:.*]] = fir.convert %[[VAL_62]] : (i32) -> i64 +! CHECK: %[[VAL_64:.*]] = fir.convert %[[VAL_61]]#0 : (index) -> i64 +! CHECK: %[[VAL_65:.*]] = arith.subi %[[VAL_63]], %[[VAL_64]] : i64 +! CHECK: %[[VAL_66:.*]] = fir.coordinate_of %[[VAL_60]], %[[VAL_65]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_67:.*]] = fir.coordinate_of %[[VAL_66]], %[[VAL_54]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_68:.*]] = fir.load %[[VAL_67]] : !fir.ref>>> +! CHECK: %[[VAL_69:.*]]:3 = fir.box_dims %[[VAL_68]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_70:.*]] = fir.convert %[[VAL_69]]#1 : (index) -> i32 +! CHECK: fir.store %[[VAL_70]] to %[[VAL_7]] : !fir.ref +! CHECK: %[[VAL_71:.*]] = fir.load %[[VAL_5]] : !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>> +! CHECK: %[[VAL_72:.*]]:3 = fir.box_dims %[[VAL_71]], %[[VAL_3]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, index) -> (index, index, index) +! CHECK: %[[VAL_73:.*]] = fir.load %[[VAL_0]] : !fir.ref +! CHECK: %[[VAL_74:.*]] = fir.convert %[[VAL_73]] : (i32) -> i64 +! CHECK: %[[VAL_75:.*]] = fir.convert %[[VAL_72]]#0 : (index) -> i64 +! CHECK: %[[VAL_76:.*]] = arith.subi %[[VAL_74]], %[[VAL_75]] : i64 +! CHECK: %[[VAL_77:.*]] = fir.coordinate_of %[[VAL_71]], %[[VAL_76]] : (!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>>>, i64) -> !fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>> +! CHECK: %[[VAL_78:.*]] = fir.field_index begs_blr_static, !fir.type<_QMdmumps_sol_lrTblr_struc_t{panels_l:!fir.box>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}> +! CHECK: %[[VAL_79:.*]] = fir.coordinate_of %[[VAL_77]], %[[VAL_78]] : (!fir.ref>>,panels_u:!fir.box>>,begs_blr_static:!fir.box>>}>>, !fir.field) -> !fir.ref>>> +! CHECK: %[[VAL_80:.*]] = fir.load %[[VAL_79]] : !fir.ref>>> +! CHECK: %[[VAL_81:.*]]:3 = fir.box_dims %[[VAL_80]], %[[VAL_3]] : (!fir.box>>, index) -> (index, index, index) +! CHECK: %[[VAL_82:.*]] = fir.convert %[[VAL_81]]#1 : (index) -> i32 +! CHECK: %[[VAL_83:.*]] = arith.subi %[[VAL_82]], %[[VAL_4]] : i32 +! CHECK: fir.store %[[VAL_83]] to %[[VAL_6]] : !fir.ref +! CHECK: br ^bb5 +! CHECK: ^bb5: +! CHECK: return +! CHECK: } + diff --git a/flang/test/Lower/logical-as-fortran.f90 b/flang/test/Lower/logical-as-fortran.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/logical-as-fortran.f90 @@ -0,0 +1,29 @@ +! Test that logicals are lowered to Fortran logical types where it matters +! RUN: bbc %s -emit-fir -o - | FileCheck %s + +! Logicals should be lowered to Fortran logical types in memory/function +! interfaces. + + +! CHECK-LABEL: _QPtest_value_arguments +subroutine test_value_arguments() +interface +subroutine foo2(l) + logical(2) :: l +end subroutine +subroutine foo4(l) + logical(4) :: l +end subroutine +end interface + + ! CHECK: %[[true2:.*]] = fir.convert %true{{.*}} : (i1) -> !fir.logical<2> + ! CHECK: fir.store %[[true2]] to %[[mem2:.*]] : !fir.ref> + ! CHECK: fir.call @_QPfoo2(%[[mem2]]) : (!fir.ref>) -> () +call foo2(.true._2) + + ! CHECK: %[[true4:.*]] = fir.convert %true{{.*}} : (i1) -> !fir.logical<4> + ! CHECK: fir.store %[[true4]] to %[[mem4:.*]] : !fir.ref> + ! CHECK: fir.call @_QPfoo4(%[[mem4]]) : (!fir.ref>) -> () +call foo4(.true.) + +end subroutine