Skip to content

Commit

Permalink
[flang] Relax checking of dummy procedures under BIND(C) (#92474)
Browse files Browse the repository at this point in the history
As was done recently to allow derived types that are not explicitly
BIND(C), but meet the requirements of BIND(C), to be acceptable for use
in contexts nominally requiring BIND(C), this patch allows procedures
that are not explicitly BIND(C) to be used in contexts that nominally
require BIND(C) so long as (1) they meet the requirements of BIND(C),
and (2) don't use dummy arguments whose implementations may vary under
BIND(C), such as VALUE.
  • Loading branch information
klausler authored May 17, 2024
1 parent fe2ff54 commit ab7930b
Show file tree
Hide file tree
Showing 7 changed files with 361 additions and 204 deletions.
27 changes: 13 additions & 14 deletions flang/include/flang/Semantics/tools.h
Original file line number Diff line number Diff line change
Expand Up @@ -213,8 +213,7 @@ inline bool IsCUDADeviceContext(const Scope *scope) {
}

inline bool HasCUDAAttr(const Symbol &sym) {
if (const auto *details{
sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
if (const auto *details{sym.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
if (details->cudaDataAttr()) {
return true;
}
Expand All @@ -224,17 +223,18 @@ inline bool HasCUDAAttr(const Symbol &sym) {

inline bool NeedCUDAAlloc(const Symbol &sym) {
bool inDeviceSubprogram{IsCUDADeviceContext(&sym.owner())};
if (Fortran::semantics::IsDummy(sym))
if (IsDummy(sym)) {
return false;
if (const auto *details{
sym.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
}
if (const auto *details{sym.GetUltimate().detailsIf<ObjectEntityDetails>()}) {
if (details->cudaDataAttr() &&
(*details->cudaDataAttr() == common::CUDADataAttr::Device ||
*details->cudaDataAttr() == common::CUDADataAttr::Managed ||
*details->cudaDataAttr() == common::CUDADataAttr::Unified)) {
// Descriptor is allocated on host when in host context.
if (Fortran::semantics::IsAllocatable(sym))
if (IsAllocatable(sym)) {
return inDeviceSubprogram;
}
return true;
}
}
Expand All @@ -246,7 +246,7 @@ std::optional<common::CUDADataAttr> GetCUDADataAttr(const Symbol *);

// Return an error if a symbol is not accessible from a scope
std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
const semantics::Scope &, const Symbol &);
const Scope &, const Symbol &);

// Analysis of image control statements
bool IsImageControlStmt(const parser::ExecutableConstruct &);
Expand Down Expand Up @@ -706,14 +706,13 @@ inline const parser::Name *getDesignatorNameIfDataRef(
bool CouldBeDataPointerValuedFunction(const Symbol *);

template <typename R, typename T>
std::optional<R> GetConstExpr(
Fortran::semantics::SemanticsContext &semanticsContext, const T &x) {
using DefaultCharConstantType = Fortran::evaluate::Ascii;
if (const auto *expr{Fortran::semantics::GetExpr(semanticsContext, x)}) {
const auto foldExpr{Fortran::evaluate::Fold(
semanticsContext.foldingContext(), Fortran::common::Clone(*expr))};
std::optional<R> GetConstExpr(SemanticsContext &semanticsContext, const T &x) {
using DefaultCharConstantType = evaluate::Ascii;
if (const auto *expr{GetExpr(semanticsContext, x)}) {
const auto foldExpr{evaluate::Fold(
semanticsContext.foldingContext(), common::Clone(*expr))};
if constexpr (std::is_same_v<R, std::string>) {
return Fortran::evaluate::GetScalarConstantValue<DefaultCharConstantType>(
return evaluate::GetScalarConstantValue<DefaultCharConstantType>(
foldExpr);
}
}
Expand Down
Loading

0 comments on commit ab7930b

Please sign in to comment.