Skip to content

Commit 3d63d21

Browse files
jeanPerierjeanPerier
committed
[flang] Do not pass derived type by descriptor when not needed
A missing "!" in the call interface lowering caused all derived type arguments without length parameters that require and explicit interface to be passed via fir.box (runtime descriptor). This was not the intent: there is no point passing a simple derived type scalars or explicit shapes by descriptor just because they have an attribute like TARGET. This would actually be problematic with existing code that is not always 100% compliant: some code implicitly calls procedures with TARGET dummy attributes (this is not something a compiler can enforce if the call and procedure definition are not in the same file). Add a Scope::IsDerivedTypeWithLengthParameter to avoid passing derived types with only kind parameters by descriptor. There is no point, the callee knows about the kind parameter values. Differential Revision: https://reviews.llvm.org/D123990
1 parent d46fa02 commit 3d63d21

File tree

5 files changed

+157
-29
lines changed

5 files changed

+157
-29
lines changed

‎flang/include/flang/Semantics/scope.h

+3
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,10 @@ class Scope {
104104
bool IsParameterizedDerivedTypeInstantiation() const {
105105
return kind_ == Kind::DerivedType && !symbol_;
106106
}
107+
/// Does this derived type have at least one kind parameter ?
107108
bool IsDerivedTypeWithKindParameter() const;
109+
/// Does this derived type have at least one length parameter ?
110+
bool IsDerivedTypeWithLengthParameter() const;
108111
Symbol *symbol() { return symbol_; }
109112
const Symbol *symbol() const { return symbol_; }
110113
SemanticsContext &context() const { return context_; }

‎flang/lib/Lower/CallInterface.cpp

+3-2
Original file line numberDiff line numberDiff line change
@@ -765,8 +765,9 @@ class Fortran::lower::CallInterfaceImpl {
765765
return true;
766766
if (const Fortran::semantics::DerivedTypeSpec *derived =
767767
Fortran::evaluate::GetDerivedTypeSpec(obj.type.type()))
768-
// Need to pass type parameters in fir.box if any.
769-
return derived->parameters().empty();
768+
if (const Fortran::semantics::Scope *scope = derived->scope())
769+
// Need to pass length type parameters in fir.box if any.
770+
return scope->IsDerivedTypeWithLengthParameter();
770771
return false;
771772
}
772773

‎flang/lib/Semantics/scope.cpp

+31-24
Original file line numberDiff line numberDiff line change
@@ -357,42 +357,49 @@ bool Scope::IsStmtFunction() const {
357357
return symbol_ && symbol_->test(Symbol::Flag::StmtFunction);
358358
}
359359

360-
bool Scope::IsParameterizedDerivedType() const {
361-
if (!IsDerivedType()) {
362-
return false;
363-
}
364-
if (const Scope * parent{GetDerivedTypeParent()}) {
365-
if (parent->IsParameterizedDerivedType()) {
366-
return true;
367-
}
368-
}
369-
for (const auto &pair : symbols_) {
370-
if (pair.second->has<TypeParamDetails>()) {
371-
return true;
372-
}
360+
template <common::TypeParamAttr... ParamAttr> struct IsTypeParamHelper {
361+
static_assert(sizeof...(ParamAttr) == 0, "must have one or zero template");
362+
static bool IsParam(const Symbol &symbol) {
363+
return symbol.has<TypeParamDetails>();
373364
}
374-
return false;
375-
}
365+
};
376366

377-
bool Scope::IsDerivedTypeWithKindParameter() const {
378-
if (!IsDerivedType()) {
367+
template <common::TypeParamAttr ParamAttr> struct IsTypeParamHelper<ParamAttr> {
368+
static bool IsParam(const Symbol &symbol) {
369+
if (const auto *typeParam{symbol.detailsIf<TypeParamDetails>()}) {
370+
return typeParam->attr() == ParamAttr;
371+
}
379372
return false;
380373
}
381-
if (const Scope * parent{GetDerivedTypeParent()}) {
382-
if (parent->IsDerivedTypeWithKindParameter()) {
383-
return true;
374+
};
375+
376+
template <common::TypeParamAttr... ParamAttr>
377+
static bool IsParameterizedDerivedTypeHelper(const Scope &scope) {
378+
if (scope.IsDerivedType()) {
379+
if (const Scope * parent{scope.GetDerivedTypeParent()}) {
380+
if (IsParameterizedDerivedTypeHelper<ParamAttr...>(*parent)) {
381+
return true;
382+
}
384383
}
385-
}
386-
for (const auto &pair : symbols_) {
387-
if (const auto *typeParam{pair.second->detailsIf<TypeParamDetails>()}) {
388-
if (typeParam->attr() == common::TypeParamAttr::Kind) {
384+
for (const auto &nameAndSymbolPair : scope) {
385+
if (IsTypeParamHelper<ParamAttr...>::IsParam(*nameAndSymbolPair.second)) {
389386
return true;
390387
}
391388
}
392389
}
393390
return false;
394391
}
395392

393+
bool Scope::IsParameterizedDerivedType() const {
394+
return IsParameterizedDerivedTypeHelper<>(*this);
395+
}
396+
bool Scope::IsDerivedTypeWithLengthParameter() const {
397+
return IsParameterizedDerivedTypeHelper<common::TypeParamAttr::Len>(*this);
398+
}
399+
bool Scope::IsDerivedTypeWithKindParameter() const {
400+
return IsParameterizedDerivedTypeHelper<common::TypeParamAttr::Kind>(*this);
401+
}
402+
396403
const DeclTypeSpec *Scope::FindInstantiatedDerivedType(
397404
const DerivedTypeSpec &spec, DeclTypeSpec::Category category) const {
398405
DeclTypeSpec type{category, spec};

‎flang/test/Lower/default-initialization.f90

+4-3
Original file line numberDiff line numberDiff line change
@@ -75,11 +75,12 @@ subroutine intent_out(x)
7575
! Test that optional intent(out) are default initialized only when
7676
! present.
7777
! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(
78-
! CHECK-SAME: %[[x:.*]]: !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
78+
! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
7979
subroutine intent_out_optional(x)
80-
! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
80+
! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
8181
! CHECK: fir.if %[[isPresent]] {
82-
! CHECK: %[[xboxNone:.*]] = fir.convert %[[x]]
82+
! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
83+
! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
8384
! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
8485
! CHECK: }
8586
type(t), intent(out), optional :: x

‎flang/test/Lower/dummy-argument-derived.f90

+116
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
! Test lowering of derived type dummy arguments
2+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
3+
module type_defs
4+
type simple_type
5+
integer :: i
6+
end type
7+
type with_kind(k)
8+
integer, kind :: k
9+
real(k) :: x
10+
end type
11+
end module
12+
13+
! -----------------------------------------------------------------------------
14+
! Test passing of derived type arguments that do not require a
15+
! fir.box (runtime descriptor).
16+
! -----------------------------------------------------------------------------
17+
18+
! Test simple type scalar with no attribute.
19+
! CHECK-LABEL: func @_QPtest1(
20+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTsimple_type{i:i32}>> {fir.bindc_name = "a"}) {
21+
subroutine test1(a)
22+
use type_defs
23+
type(simple_type) :: a
24+
end subroutine
25+
26+
! Test simple type explicit array with no attribute.
27+
! CHECK-LABEL: func @_QPtest2(
28+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a"}) {
29+
subroutine test2(a)
30+
use type_defs
31+
type(simple_type) :: a(100)
32+
end subroutine
33+
34+
! Test simple type scalar with TARGET attribute.
35+
! CHECK-LABEL: func @_QPtest3(
36+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTsimple_type{i:i32}>> {fir.bindc_name = "a", fir.target}) {
37+
subroutine test3(a)
38+
use type_defs
39+
type(simple_type), target :: a
40+
end subroutine
41+
42+
! Test simple type explicit array with TARGET attribute.
43+
! CHECK-LABEL: func @_QPtest4(
44+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a", fir.target}) {
45+
subroutine test4(a)
46+
use type_defs
47+
type(simple_type), target :: a(100)
48+
end subroutine
49+
50+
! Test kind parametrized derived type scalar with no attribute.
51+
! CHECK-LABEL: func @_QPtest1k(
52+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTwith_kindK4{x:f32}>> {fir.bindc_name = "a"}) {
53+
subroutine test1k(a)
54+
use type_defs
55+
type(with_kind(4)) :: a
56+
end subroutine
57+
58+
! Test kind parametrized derived type explicit array with no attribute.
59+
! CHECK-LABEL: func @_QPtest2k(
60+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a"}) {
61+
subroutine test2k(a)
62+
use type_defs
63+
type(with_kind(4)) :: a(100)
64+
end subroutine
65+
66+
! Test kind parametrized derived type scalar with TARGET attribute.
67+
! CHECK-LABEL: func @_QPtest3k(
68+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.type<_QMtype_defsTwith_kindK4{x:f32}>> {fir.bindc_name = "a", fir.target}) {
69+
subroutine test3k(a)
70+
use type_defs
71+
type(with_kind(4)), target :: a
72+
end subroutine
73+
74+
! Test kind parametrized derived type explicit array with TARGET attribute.
75+
! CHECK-LABEL: func @_QPtest4k(
76+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a", fir.target}) {
77+
subroutine test4k(a)
78+
use type_defs
79+
type(with_kind(4)), target :: a(100)
80+
end subroutine
81+
82+
! -----------------------------------------------------------------------------
83+
! Test passing of derived type arguments that require a fir.box (runtime descriptor).
84+
! -----------------------------------------------------------------------------
85+
86+
! Test simple type assumed shape array with no attribute.
87+
! CHECK-LABEL: func @_QPtest5(
88+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a"}) {
89+
subroutine test5(a)
90+
use type_defs
91+
type(simple_type) :: a(:)
92+
end subroutine
93+
94+
! Test simple type assumed shape array with TARGET attribute.
95+
! CHECK-LABEL: func @_QPtest6(
96+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTsimple_type{i:i32}>>> {fir.bindc_name = "a", fir.target}) {
97+
subroutine test6(a)
98+
use type_defs
99+
type(simple_type), target :: a(:)
100+
end subroutine
101+
102+
! Test kind parametrized derived type assumed shape array with no attribute.
103+
! CHECK-LABEL: func @_QPtest5k(
104+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a"}) {
105+
subroutine test5k(a)
106+
use type_defs
107+
type(with_kind(4)) :: a(:)
108+
end subroutine
109+
110+
! Test kind parametrized derived type assumed shape array with TARGET attribute.
111+
! CHECK-LABEL: func @_QPtest6k(
112+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMtype_defsTwith_kindK4{x:f32}>>> {fir.bindc_name = "a", fir.target}) {
113+
subroutine test6k(a)
114+
use type_defs
115+
type(with_kind(4)), target :: a(:)
116+
end subroutine

0 commit comments

Comments
 (0)