Skip to content

Commit

Permalink
[flang] Relax checking of dummy procedures under BIND(C)
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 committed May 16, 2024
1 parent c87b1ca commit dace67c
Show file tree
Hide file tree
Showing 7 changed files with 337 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 dace67c

Please sign in to comment.