shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang] Relax BIND(C) derived type component check (#94392)

Browse Source 
Allow an explicit BIND(C) derived type to have a non-BIND(C) component
so long as the component's type is interoperable and it satisfies all
other constraints.
This commit is contained in:
Peter Klausler 2024-06-11 16:38:51 -07:00 committed by GitHub
parent 11a4d43f4a
commit 56cd8a50b3
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 15 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
flang/lib/Semantics/check-declarations.cpp
View File

@ -138,7 +138,7 @@ private:
void CheckGlobalName(const Symbol &);
void CheckProcedureAssemblyName(const Symbol &symbol);
void CheckExplicitSave(const Symbol &);
parser::Messages WhyNotInteroperableDerivedType(const Symbol &, bool isError);
parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
parser::Messages WhyNotInteroperableObject(const Symbol &, bool isError);
parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
@ -2892,13 +2892,12 @@ void CheckHelper::CheckProcedureAssemblyName(const Symbol &symbol) {
}
parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
const Symbol &symbol, bool isError) {
const Symbol &symbol) {
parser::Messages msgs;
if (examinedByWhyNotInteroperable_.find(symbol) !=
examinedByWhyNotInteroperable_.end()) {
return msgs;
}
isError |= symbol.attrs().test(Attr::BIND_C);
examinedByWhyNotInteroperable_.insert(symbol);
if (const auto *derived{symbol.detailsIf<DerivedTypeDetails>()}) {
if (derived->sequence()) { // C1801
@ -2909,14 +2908,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
"An interoperable derived type cannot have a type parameter"_err_en_US);
} else if (const auto *parent{
symbol.scope()->GetDerivedTypeParent()}) { // C1803
if (isError) {
if (symbol.attrs().test(Attr::BIND_C)) {
msgs.Say(symbol.name(),
"A derived type with the BIND attribute cannot be an extended derived type"_err_en_US);
} else {
bool interoperableParent{true};
if (parent->symbol()) {
auto bad{WhyNotInteroperableDerivedType(
*parent->symbol(), /*isError=*/false)};
auto bad{WhyNotInteroperableDerivedType(*parent->symbol())};
if (bad.AnyFatalError()) {
auto &msg{msgs.Say(symbol.name(),
"The parent of an interoperable type is not interoperable"_err_en_US)};
@ -2946,8 +2944,7 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
"An interoperable derived type cannot have a pointer or allocatable component"_err_en_US);
} else if (const auto *type{component.GetType()}) {
if (const auto *derived{type->AsDerived()}) {
auto bad{
WhyNotInteroperableDerivedType(derived->typeSymbol(), isError)};
auto bad{WhyNotInteroperableDerivedType(derived->typeSymbol())};
if (bad.AnyFatalError()) {
auto &msg{msgs.Say(component.name(),
"Component '%s' of an interoperable derived type must have an interoperable type but does not"_err_en_US,
@ -2999,13 +2996,6 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
}
}
}
if (isError) {
for (auto &m : msgs.messages()) {
if (!m.IsFatal()) {
m.set_severity(parser::Severity::Error);
}
}
}
if (msgs.AnyFatalError()) {
examinedByWhyNotInteroperable_.erase(symbol);
}
@ -3055,8 +3045,8 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
msgs.Say(symbol.name(),
"The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)
.Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
} else if (auto bad{WhyNotInteroperableDerivedType(
derived->typeSymbol(), /*isError=*/false)};
} else if (auto bad{
WhyNotInteroperableDerivedType(derived->typeSymbol())};
bad.AnyFatalError()) {
bad.AttachTo(
msgs.Say(symbol.name(),
@ -3261,8 +3251,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
symbol.has<SubprogramDetails>()) {
whyNot = WhyNotInteroperableProcedure(symbol, /*isError=*/isExplicitBindC);
} else if (symbol.has<DerivedTypeDetails>()) {
whyNot =
WhyNotInteroperableDerivedType(symbol, /*isError=*/isExplicitBindC);
whyNot = WhyNotInteroperableDerivedType(symbol);
}
if (!whyNot.empty()) {
bool anyFatal{whyNot.AnyFatalError()};

7
flang/test/Semantics/bind-c15.f90
View File

@ -16,6 +16,13 @@ module m
type :: non_interoperable2
type(non_interoperable1) b
end type
type :: no_bind_c
real a
end type
type, bind(c) :: has_bind_c
!WARNING: Derived type of component 'a' of an interoperable derived type should have the BIND attribute
type(no_bind_c) :: a
end type
interface
subroutine sub_bind_c_1(x_bind_c) bind(c)
import explicit_bind_c