Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions flang/include/flang/Semantics/symbol.h
Original file line number Diff line number Diff line change
Expand Up @@ -435,12 +435,17 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
void set_init(std::nullptr_t) { init_ = nullptr; }
bool isCUDAKernel() const { return isCUDAKernel_; }
void set_isCUDAKernel(bool yes = true) { isCUDAKernel_ = yes; }
std::optional<SourceName> usedAsProcedureHere() const {
return usedAsProcedureHere_;
}
void set_usedAsProcedureHere(SourceName here) { usedAsProcedureHere_ = here; }

private:
const Symbol *rawProcInterface_{nullptr};
const Symbol *procInterface_{nullptr};
std::optional<const Symbol *> init_;
bool isCUDAKernel_{false};
std::optional<SourceName> usedAsProcedureHere_;
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const ProcEntityDetails &);
};
Expand Down
47 changes: 30 additions & 17 deletions flang/lib/Semantics/resolve-names.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -687,7 +687,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
Symbol &, bool respectImplicitNoneType = true);
void CheckEntryDummyUse(SourceName, Symbol *);
bool ConvertToObjectEntity(Symbol &);
bool ConvertToProcEntity(Symbol &);
bool ConvertToProcEntity(Symbol &, std::optional<SourceName> = std::nullopt);

const DeclTypeSpec &MakeNumericType(
TypeCategory, const std::optional<parser::KindSelector> &);
Expand Down Expand Up @@ -2253,14 +2253,19 @@ void ScopeHandler::SayWithReason(const parser::Name &name, Symbol &symbol,

void ScopeHandler::SayWithDecl(
const parser::Name &name, Symbol &symbol, MessageFixedText &&msg) {
bool isFatal{msg.IsFatal()};
Say(name, std::move(msg), symbol.name())
.Attach(Message{symbol.name(),
symbol.test(Symbol::Flag::Implicit)
? "Implicit declaration of '%s'"_en_US
: "Declaration of '%s'"_en_US,
name.source});
context().SetError(symbol, isFatal);
auto &message{Say(name, std::move(msg), symbol.name())
.Attach(Message{symbol.name(),
symbol.test(Symbol::Flag::Implicit)
? "Implicit declaration of '%s'"_en_US
: "Declaration of '%s'"_en_US,
name.source})};
if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (auto usedAsProc{proc->usedAsProcedureHere()}) {
if (usedAsProc->begin() != symbol.name().begin()) {
message.Attach(Message{*usedAsProc, "Referenced as a procedure"_en_US});
}
}
}
}

void ScopeHandler::SayLocalMustBeVariable(
Expand Down Expand Up @@ -2659,9 +2664,9 @@ bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
return true;
}
// Convert symbol to be a ProcEntity or return false if it can't be.
bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
bool ScopeHandler::ConvertToProcEntity(
Symbol &symbol, std::optional<SourceName> usedHere) {
if (symbol.has<ProcEntityDetails>()) {
// nothing to do
} else if (symbol.has<UnknownDetails>()) {
symbol.set_details(ProcEntityDetails{});
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
Expand All @@ -2684,6 +2689,10 @@ bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
} else {
return false;
}
auto &proc{symbol.get<ProcEntityDetails>()};
if (usedHere && !proc.usedAsProcedureHere()) {
proc.set_usedAsProcedureHere(*usedHere);
}
return true;
}

Expand Down Expand Up @@ -4805,7 +4814,7 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
HandleAttributeStmt(Attr::EXTERNAL, x.v);
for (const auto &name : x.v) {
auto *symbol{FindSymbol(name)};
if (!ConvertToProcEntity(DEREF(symbol))) {
if (!ConvertToProcEntity(DEREF(symbol), name.source)) {
// Check if previous symbol is an interface.
if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
if (details->isInterface()) {
Expand Down Expand Up @@ -4845,7 +4854,7 @@ void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
auto &symbol{DEREF(FindSymbol(name))};
if (symbol.has<GenericDetails>()) {
// Generic interface is extending intrinsic; ok
} else if (!ConvertToProcEntity(symbol)) {
} else if (!ConvertToProcEntity(symbol, name.source)) {
SayWithDecl(
name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
} else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
Expand Down Expand Up @@ -7705,6 +7714,7 @@ const parser::Name *DeclarationVisitor::ResolveDataRef(
} else if (!context().HasError(*name->symbol)) {
SayWithDecl(*name, *name->symbol,
"Cannot reference function '%s' as data"_err_en_US);
context().SetError(*name->symbol);
}
}
return name;
Expand Down Expand Up @@ -8119,7 +8129,7 @@ void ResolveNamesVisitor::HandleProcedureName(
symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
}
Resolve(name, *symbol);
ConvertToProcEntity(*symbol);
ConvertToProcEntity(*symbol, name.source);
if (!symbol->attrs().test(Attr::INTRINSIC)) {
if (CheckImplicitNoneExternal(name.source, *symbol)) {
MakeExternal(*symbol);
Expand All @@ -8144,7 +8154,7 @@ void ResolveNamesVisitor::HandleProcedureName(
name.symbol = symbol;
}
CheckEntryDummyUse(name.source, symbol);
bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
bool convertedToProcEntity{ConvertToProcEntity(*symbol, name.source)};
if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
AcquireIntrinsicProcedureFlags(*symbol);
Expand Down Expand Up @@ -8203,7 +8213,7 @@ void ResolveNamesVisitor::NoteExecutablePartCall(
? Symbol::Flag::Function
: Symbol::Flag::Subroutine};
if (!symbol->test(other)) {
ConvertToProcEntity(*symbol);
ConvertToProcEntity(*symbol, name);
if (auto *details{symbol->detailsIf<ProcEntityDetails>()}) {
symbol->set(flag);
if (IsDummy(*symbol)) {
Expand Down Expand Up @@ -8240,11 +8250,13 @@ bool ResolveNamesVisitor::SetProcFlag(
if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
SayWithDecl(
name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
context().SetError(symbol);
return false;
} else if (symbol.test(Symbol::Flag::Subroutine) &&
flag == Symbol::Flag::Function) {
SayWithDecl(
name, symbol, "Cannot call subroutine '%s' like a function"_err_en_US);
context().SetError(symbol);
return false;
} else if (flag == Symbol::Flag::Function &&
IsLocallyImplicitGlobalSymbol(symbol, name) &&
Expand All @@ -8263,6 +8275,7 @@ bool ResolveNamesVisitor::SetProcFlag(
} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
SayWithDecl(
name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
context().SetError(symbol);
} else if (symbol.attrs().test(Attr::INTRINSIC)) {
AcquireIntrinsicProcedureFlags(symbol);
}
Expand Down Expand Up @@ -8724,7 +8737,7 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
context().globalScope(), name->source, Attrs{Attr::EXTERNAL})};
symbol.implicitAttrs().set(Attr::EXTERNAL);
Resolve(*name, symbol);
ConvertToProcEntity(symbol);
ConvertToProcEntity(symbol, name->source);
return false;
}
}
Expand Down
3 changes: 1 addition & 2 deletions flang/test/Semantics/select-rank.f90
Original file line number Diff line number Diff line change
Expand Up @@ -219,11 +219,10 @@ subroutine CALL_ME10(x)
SELECT RANK(ptr=>x)
RANK (3)
PRINT *, "PRINT RANK 3"
!ERROR: 'ptr' is not an object that can appear in an expression
!ERROR: 'kind=' argument must be a constant scalar integer whose value is a supported kind for the intrinsic result type
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 0))
RANK (1)
PRINT *, "PRINT RANK 1"
!ERROR: 'ptr' is not an object that can appear in an expression
j = INT(0, KIND=MERGE(KIND(0), -1, RANK(ptr) == 1))
END SELECT
end subroutine
Expand Down