diff --git a/flang/test/Lower/module-and-internal-proc.f90 b/flang/test/Lower/module-and-internal-proc.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/module-and-internal-proc.f90 @@ -0,0 +1,39 @@ +! Test that module data access are lowered correctly in the different +! procedure contexts. +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +module parent + integer :: i +contains +! Test simple access to the module data +! CHECK-LABEL: func @_QMparentPtest1 +subroutine test1() + ! CHECK: fir.address_of(@_QMparentEi) : !fir.ref + print *, i +end subroutine + +! Test access to the module data inside an internal procedure where the +! host is defined inside the module. +subroutine test2() + call test2internal() + contains + ! CHECK-LABEL: func @_QMparentFtest2Ptest2internal() + subroutine test2internal() + ! CHECK: fir.address_of(@_QMparentEi) : !fir.ref + print *, i + end subroutine +end subroutine +end module + +! Test access to the module data inside an internal procedure where the +! host is using the module. +subroutine test3() + use parent + call test3internal() + contains + ! CHECK-LABEL: func @_QFtest3Ptest3internal() + subroutine test3internal() + ! CHECK: fir.address_of(@_QMparentEi) : !fir.ref + print *, i + end subroutine +end subroutine diff --git a/flang/test/Lower/module-single-point-of-def.f90 b/flang/test/Lower/module-single-point-of-def.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/module-single-point-of-def.f90 @@ -0,0 +1,78 @@ +! Test that module variables with an initializer are only defined once, +! except for compiler generated derived type descriptor that should be +! always fully defined as linkonce_odr by the compilation units defining or +! using them. +! Test that this holds true in contexts with namelist members that are special +! because the symbol on the use site are not symbols with semantics::UseDetails, +! but directly the symbols from the module scope. + + +! RUN: split-file %s %t +! RUN: bbc -emit-fir %t/definition-a.f90 -o - | FileCheck %s --check-prefix=CHECK-A-DEF +! RUN: bbc -emit-fir %t/definition-b.f90 -o - | FileCheck %s --check-prefix=CHECK-B-DEF +! RUN: bbc -emit-fir %t/use.f90 -o - | FileCheck %s --check-prefix=CHECK-USE + + + +!--- definition-a.f90 + +! Test definition of `atype` derived type descriptor as `linkonce_odr` +module define_a + type atype + real :: x + end type +end module + +! CHECK-A-DEF: fir.global linkonce_odr @_QMdefine_aE.dt.atype constant : !fir.type<{{.*}}> { +! CHECK-A-DEF: fir.has_value +! CHECK-A-DEF: } + +!--- definition-b.f90 + +! Test define_b `i` is defined here. +! Also test that the derived type descriptor of types defined here (`btype`) and used +! here (`atype`) are fully defined here as linkonce_odr. +module define_b + use :: define_a + type btype + type(atype) :: atype + end type + integer :: i = 42 + namelist /some_namelist/ i +end module + +! CHECK-B-DEF: fir.global @_QMdefine_bEi : i32 { +! CHECK-B-DEF: fir.has_value %{{.*}} : i32 +! CHECK-B-DEF: } + +! CHECK-B-DEF: fir.global linkonce_odr @_QMdefine_bE.dt.btype constant : !fir.type<{{.*}}> { +! CHECK-B-DEF: fir.has_value +! CHECK-B-DEF: } + +! CHECK-B-DEF: fir.global linkonce_odr @_QMdefine_aE.dt.atype constant : !fir.type<{{.*}}> { +! CHECK-B-DEF: fir.has_value +! CHECK-B-DEF: } + + + +!--- use.f90 + +! Test define_b `i` is declared but not defined here and that derived types +! descriptors are fully defined as linkonce_odr here. +subroutine foo() + use :: define_b + type(btype) :: somet + print *, somet + write(*, some_namelist) +end subroutine +! CHECK-USE: fir.global @_QMdefine_bEi : i32{{$}} +! CHECK-USE-NOT: fir.has_value %{{.*}} : i32 + +! CHECK-USE: fir.global linkonce_odr @_QMdefine_aE.dt.atype constant : !fir.type<{{.*}}> { +! CHECK-USE: fir.has_value +! CHECK-USE: } + +! CHECK-USE: fir.global linkonce_odr @_QMdefine_bE.dt.btype constant : !fir.type<{{.*}}> { +! CHECK-USE: fir.has_value +! CHECK-USE: } + diff --git a/flang/test/Lower/module_definition.f90 b/flang/test/Lower/module_definition.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/module_definition.f90 @@ -0,0 +1,69 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test lowering of module that defines data that is otherwise not used +! in this file. + +! Module m1 defines simple data +module m1 + real :: x + integer :: y(100) +end module +! CHECK: fir.global @_QMm1Ex : f32 +! CHECK: fir.global @_QMm1Ey : !fir.array<100xi32> + +! Module modEq1 defines data that is equivalenced and not used in this +! file. +module modEq1 + ! Equivalence, no initialization + real :: x1(10), x2(10), x3(10) + ! Equivalence with initialization + real :: y1 = 42. + real :: y2(10) + equivalence (x1(1), x2(5), x3(10)), (y1, y2(5)) +end module +! CHECK-LABEL: fir.global @_QMmodeq1Ex1 : !fir.array<76xi8> +! CHECK-LABEL: fir.global @_QMmodeq1Ey1 : !fir.array<10xi32> { + ! CHECK: %[[undef:.*]] = fir.undefined !fir.array<10xi32> + ! CHECK: %[[v1:.*]] = fir.insert_on_range %0, %c0{{.*}} from (0) to (3) : (!fir.array<10xi32>, i32) -> !fir.array<10xi32> + ! CHECK: %[[v2:.*]] = fir.insert_value %1, %c1109917696{{.*}}, [4 : index] : (!fir.array<10xi32>, i32) -> !fir.array<10xi32> + ! CHECK: %[[v3:.*]] = fir.insert_on_range %2, %c0{{.*}} from (5) to (9) : (!fir.array<10xi32>, i32) -> !fir.array<10xi32> + ! CHECK: fir.has_value %[[v3]] : !fir.array<10xi32> + +! Module defines variable in common block without initializer +module modCommonNoInit1 + ! Module variable is in blank common + real :: x_blank + common // x_blank + ! Module variable is in named common, no init + real :: x_named1 + common /named1/ x_named1 +end module +! CHECK-LABEL: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8> +! CHECK-LABEL: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8> + +! Module defines variable in common block with initialization +module modCommonInit1 + integer :: i_named2 = 42 + common /named2/ i_named2 +end module +! CHECK-LABEL: fir.global @_QBnamed2 : tuple { + ! CHECK: %[[init:.*]] = fir.insert_value %{{.*}}, %c42{{.*}}, [0 : index] : (tuple, i32) -> tuple + ! CHECK: fir.has_value %[[init]] : tuple + +! Test defining two module variables whose initializers depend on each others +! addresses. +module global_init_depending_on_each_other_address + type a + type(b), pointer :: pb + end type + type b + type(a), pointer :: pa + end type + type(a), target :: xa + type(b), target :: xb + data xa, xb/a(xb), b(xa)/ +end module +! CHECK-LABEL: fir.global @_QMglobal_init_depending_on_each_other_addressExb + ! CHECK: fir.address_of(@_QMglobal_init_depending_on_each_other_addressExa) +! CHECK-LABEL: fir.global @_QMglobal_init_depending_on_each_other_addressExa + ! CHECK: fir.address_of(@_QMglobal_init_depending_on_each_other_addressExb) diff --git a/flang/test/Lower/module_use.f90 b/flang/test/Lower/module_use.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/module_use.f90 @@ -0,0 +1,42 @@ +! RUN: bbc -emit-fir %S/module_definition.f90 +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test use of module data not defined in this file. +! The modules are defined in module_definition.f90 +! The first runs ensures the module file is generated. + +! CHECK-LABEL: func @_QPm1use() +real function m1use() + use m1 + ! CHECK-DAG: fir.address_of(@_QMm1Ex) : !fir.ref + ! CHECK-DAG: fir.address_of(@_QMm1Ey) : !fir.ref> + m1use = x + y(1) +end function + +! TODO: test equivalences once front-end fix in module file is pushed. +!! CHECK-LABEL func @_QPmodeq1use() +!real function modEq1use() +! use modEq1 +! ! CHECK-DAG fir.address_of(@_QMmodeq1Ex1) : !fir.ref, !fir.array<40xi8>>> +! ! CHECK-DAG fir.address_of(@_QMmodeq1Ey1) : !fir.ref, !fir.array<24xi8>>> +! modEq1use = x2(1) + y1 +!end function +! CHECK-DAG fir.global @_QMmodeq1Ex1 : tuple, !fir.array<40xi8>> +! CHECK-DAG fir.global @_QMmodeq1Ey1 : tuple, !fir.array<24xi8>> + +! CHECK-LABEL: func @_QPmodcommon1use() +real function modCommon1Use() + use modCommonInit1 + use modCommonNoInit1 + ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + modCommon1Use = x_blank + x_named1 + i_named2 +end function + + +! CHECK-DAG: fir.global @_QMm1Ex : f32 +! CHECK-DAG: fir.global @_QMm1Ey : !fir.array<100xi32> +! CHECK-DAG: fir.global common @_QBnamed2(dense<0> : vector<4xi8>) : !fir.array<4xi8> +! CHECK-DAG: fir.global common @_QB(dense<0> : vector<4xi8>) : !fir.array<4xi8> +! CHECK-DAG: fir.global common @_QBnamed1(dense<0> : vector<4xi8>) : !fir.array<4xi8> diff --git a/flang/test/Lower/module_use_in_same_file.f90 b/flang/test/Lower/module_use_in_same_file.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/module_use_in_same_file.f90 @@ -0,0 +1,122 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! Test use of module data that is defined in this file. +! TODO: similar tests for the functions that are using the modules, but without the +! module being defined in this file. This require a front-end fix to be pushed first +! so + +! Module m2 defines simple data +module m2 + real :: x + integer :: y(100) +contains + ! CHECK-LABEL: func @_QMm2Pfoo() + real function foo() + ! CHECK-DAG: fir.address_of(@_QMm2Ex) : !fir.ref + ! CHECK-DAG: fir.address_of(@_QMm2Ey) : !fir.ref> + foo = x + y(1) + end function +end module +! CHECK-LABEL: func @_QPm2use() +real function m2use() + use m2 + ! CHECK-DAG: fir.address_of(@_QMm2Ex) : !fir.ref + ! CHECK-DAG: fir.address_of(@_QMm2Ey) : !fir.ref> + m2use = x + y(1) +end function +! Test renaming +! CHECK-LABEL: func @_QPm2use_rename() +real function m2use_rename() + use m2, only: renamedx => x + ! CHECK-DAG: fir.address_of(@_QMm2Ex) : !fir.ref + m2use_rename = renamedx +end function + +! Module modEq2 defines data that is equivalenced +module modEq2 + ! Equivalence, no initialization + real :: x1(10), x2(10), x3(10) + ! Equivalence with initialization + real :: y1 = 42. + real :: y2(10) + equivalence (x1(1), x2(5), x3(10)), (y1, y2(5)) +contains + ! CHECK-LABEL: func @_QMmodeq2Pfoo() + real function foo() + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ex1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ey1) : !fir.ref> + foo = x2(1) + y1 + end function +end module +! CHECK-LABEL: func @_QPmodeq2use() +real function modEq2use() + use modEq2 + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ex1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ey1) : !fir.ref> + modEq2use = x2(1) + y1 +end function +! Test rename of used equivalence members +! CHECK-LABEL: func @_QPmodeq2use_rename() +real function modEq2use_rename() + use modEq2, only: renamedx => x2, renamedy => y1 + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ex1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ey1) : !fir.ref> + modEq2use = renamedx(1) + renamedy +end function + + +! Module defines variable in common block +module modCommon2 + ! Module variable is in blank common + real :: x_blank + common // x_blank + ! Module variable is in named common, no init + real :: x_named1(10) + common /named1/ x_named1 + ! Module variable is in named common, with init + integer :: i_named2 = 42 + common /named2/ i_named2 +contains + ! CHECK-LABEL: func @_QMmodcommon2Pfoo() + real function foo() + ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + foo = x_blank + x_named1(5) + i_named2 + end function +end module +! CHECK-LABEL: func @_QPmodcommon2use() +real function modCommon2use() + use modCommon2 + ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + modCommon2use = x_blank + x_named1(5) + i_named2 +end function +! CHECK-LABEL: func @_QPmodcommon2use_rename() +real function modCommon2use_rename() + use modCommon2, only : renamed0 => x_blank, renamed1 => x_named1, renamed2 => i_named2 + ! CHECK-DAG: fir.address_of(@_QBnamed2) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QB) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QBnamed1) : !fir.ref> + modCommon2use_rename = renamed0 + renamed1(5) + renamed2 +end function + + +! Test that there are no conflicts between equivalence use associated and the ones +! from the scope +real function test_no_equiv_conflicts() + use modEq2 + ! Same equivalences as in modEq2. Test that lowering does not mixes + ! up the equivalence based on the similar offset inside the scope. + real :: x1l(10), x2l(10), x3l(10) + real :: y1l = 42. + real :: y2l(10) + save :: x1l, x2l, x3l, y1l, y2l + equivalence (x1l(1), x2l(5), x3l(10)), (y1l, y2l(5)) + ! CHECK-DAG: fir.address_of(@_QFtest_no_equiv_conflictsEx1l) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QFtest_no_equiv_conflictsEy1l) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ex1) : !fir.ref> + ! CHECK-DAG: fir.address_of(@_QMmodeq2Ey1) : !fir.ref> + test_no_equiv_conflicts = x2(1) + y1 + x2l(1) + y1l +end function