Cold-Air-Networks/mirror-llvm-project
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 7

[flang] Catch bad members of BIND(C) COMMON block (#148971)

Browse source 
Variables that can't be BIND(C), like pointers, can't be in a BIND(C)
common block, either.

Fixes https://github.com/llvm/llvm-project/issues/148922.
This commit is contained in:
Peter Klausler 2025-07-16 09:10:26 -07:00 committed by GitHub
parent bbcdad1f8e
commit 3de11b7062
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
2 changed files with 44 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
flang/lib/Semantics/check-declarations.cpp
View file

@ -151,8 +151,8 @@ private:
void CheckProcedureAssemblyName(const Symbol &symbol);
void CheckExplicitSave(const Symbol &);
parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
parser::Messages WhyNotInteroperableObject(
const Symbol &, bool allowNonInteroperableType = false);
parser::Messages WhyNotInteroperableObject(const Symbol &,
bool allowNonInteroperableType = false, bool forCommonBlock = false);
parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
void CheckBindC(const Symbol &);
@ -519,11 +519,35 @@ void CheckHelper::Check(const Symbol &symbol) {
}
void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
auto restorer{messages_.SetLocation(symbol.name())};
CheckGlobalName(symbol);
if (symbol.attrs().test(Attr::BIND_C)) {
CheckBindC(symbol);
for (auto ref : symbol.get<CommonBlockDetails>().objects()) {
if (ref->has<ObjectEntityDetails>()) {
if (auto msgs{WhyNotInteroperableObject(*ref,
/*allowInteroperableType=*/false, /*forCommonBlock=*/true)};
!msgs.empty()) {
parser::Message &reason{msgs.messages().front()};
parser::Message *msg{nullptr};
if (reason.IsFatal()) {
msg = messages_.Say(symbol.name(),
"'%s' may not be a member of BIND(C) COMMON block /%s/"_err_en_US,
ref->name(), symbol.name());
} else {
msg = messages_.Say(symbol.name(),
"'%s' should not be a member of BIND(C) COMMON block /%s/"_warn_en_US,
ref->name(), symbol.name());
}
if (msg) {
msg->Attach(
std::move(reason.set_severity(parser::Severity::Because)));
}
}
}
}
}
for (MutableSymbolRef ref : symbol.get<CommonBlockDetails>().objects()) {
for (auto ref : symbol.get<CommonBlockDetails>().objects()) {
if (ref->test(Symbol::Flag::CrayPointee)) {
messages_.Say(ref->name(),
"Cray pointee '%s' may not be a member of a COMMON block"_err_en_US,
@ -3154,14 +3178,16 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
}
parser::Messages CheckHelper::WhyNotInteroperableObject(
const Symbol &symbol, bool allowNonInteroperableType) {
const Symbol &symbol, bool allowNonInteroperableType, bool forCommonBlock) {
parser::Messages msgs;
if (examinedByWhyNotInteroperable_.find(symbol) !=
examinedByWhyNotInteroperable_.end()) {
return msgs;
if (!forCommonBlock) {
if (examinedByWhyNotInteroperable_.find(symbol) !=
examinedByWhyNotInteroperable_.end()) {
return msgs;
}
examinedByWhyNotInteroperable_.insert(symbol);
}
bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
examinedByWhyNotInteroperable_.insert(symbol);
CHECK(symbol.has<ObjectEntityDetails>());
if (isExplicitBindC && !symbol.owner().IsModule()) {
msgs.Say(symbol.name(),
@ -3258,7 +3284,7 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
msgs.Say(symbol.name(),
"An interoperable pointer must not be CONTIGUOUS"_err_en_US);
}
if (msgs.AnyFatalError()) {
if (!forCommonBlock && msgs.AnyFatalError()) {
examinedByWhyNotInteroperable_.erase(symbol);
}
return msgs;
@ -3338,8 +3364,8 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
// on the C side by either a cdesc_t * or a void *. F'2023 18.3.7 (5)
bool allowNonInteroperableType{!dummy->attrs().test(Attr::VALUE) &&
(IsDescriptor(*dummy) || IsAssumedType(*dummy))};
dummyMsgs =
WhyNotInteroperableObject(*dummy, allowNonInteroperableType);
dummyMsgs = WhyNotInteroperableObject(
*dummy, allowNonInteroperableType, /*forCommonBlock=*/false);
} else {
CheckBindC(*dummy);
}

7
flang/test/Semantics/bind-c18.f90 Normal file
View file

@ -0,0 +1,7 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
bind(c) :: /blk/
!ERROR: 'x' may not be a member of BIND(C) COMMON block /blk/
common /blk/ x
!BECAUSE: A scalar interoperable variable may not be ALLOCATABLE or POINTER
integer, pointer :: x
end