[flang-commits] [flang] c4dbe59 - [flang] Fixes for problems with declaring procedure entities
Pete Steinfeld via flang-commits
flang-commits at lists.llvm.org
Tue May 26 12:17:52 PDT 2020
Author: Pete Steinfeld
Date: 2020-05-26T12:17:20-07:00
New Revision: c4dbe59ae8253d73b63e5fcce0bc8bc44b4d07b5
URL: https://github.com/llvm/llvm-project/commit/c4dbe59ae8253d73b63e5fcce0bc8bc44b4d07b5
DIFF: https://github.com/llvm/llvm-project/commit/c4dbe59ae8253d73b63e5fcce0bc8bc44b4d07b5.diff
LOG: [flang] Fixes for problems with declaring procedure entities
Summary:
We were not detecting declaring multiple interfaces to the same procedure.
Also, we were not handling the initialization of entitiies where the associated
Symbol had previously had errors.
I added the function `IsInterfaceSet()` to ProcEntityDetails to see if
the value of `interface_` had been previously set. I then checked this
function before calling set_interface() and emitted an error message if
the interface was already set.
Also, in situations where we were emitting error messages for symbols, I
set the Error flag on the Symbol. Then when performing initialization
on the Symbol, I first check to see if the Symbol had an error.
Reviewers: tskeith, klausler, DavidTruby
Subscribers: llvm-commits
Tags: #llvm
Differential Revision: https://reviews.llvm.org/D80453
Added:
flang/test/Semantics/resolve91.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 2a95f483a173..34e4ea95eb4a 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -218,7 +218,13 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
const ProcInterface &interface() const { return interface_; }
ProcInterface &interface() { return interface_; }
- void set_interface(const ProcInterface &interface) { interface_ = interface; }
+ void set_interface(const ProcInterface &interface) {
+ CHECK(!IsInterfaceSet());
+ interface_ = interface;
+ }
+ bool IsInterfaceSet() {
+ return interface_.symbol() != nullptr || interface_.type() != nullptr;
+ }
inline bool HasExplicitInterface() const;
// Be advised: !init().has_value() => uninitialized pointer,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 175d02597dfa..3b60969b122a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3435,18 +3435,25 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
const parser::Name &name, Attrs attrs, const ProcInterface &interface) {
Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
- if (interface.type()) {
- symbol.set(Symbol::Flag::Function);
- } else if (interface.symbol()) {
- if (interface.symbol()->test(Symbol::Flag::Function)) {
+ if (details->IsInterfaceSet()) {
+ SayWithDecl(name, symbol,
+ "The interface for procedure '%s' has already been "
+ "declared"_err_en_US);
+ context().SetError(symbol);
+ } else {
+ if (interface.type()) {
symbol.set(Symbol::Flag::Function);
- } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
- symbol.set(Symbol::Flag::Subroutine);
+ } else if (interface.symbol()) {
+ if (interface.symbol()->test(Symbol::Flag::Function)) {
+ symbol.set(Symbol::Flag::Function);
+ } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
+ symbol.set(Symbol::Flag::Subroutine);
+ }
}
+ details->set_interface(interface);
+ SetBindNameOn(symbol);
+ SetPassNameOn(symbol);
}
- details->set_interface(interface);
- SetBindNameOn(symbol);
- SetPassNameOn(symbol);
}
return symbol;
}
@@ -3460,18 +3467,22 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
}
if (!arraySpec().empty()) {
if (details->IsArray()) {
- Say(name,
- "The dimensions of '%s' have already been declared"_err_en_US);
- context().SetError(symbol);
+ if (!context().HasError(symbol)) {
+ Say(name,
+ "The dimensions of '%s' have already been declared"_err_en_US);
+ context().SetError(symbol);
+ }
} else {
details->set_shape(arraySpec());
}
}
if (!coarraySpec().empty()) {
if (details->IsCoarray()) {
- Say(name,
- "The codimensions of '%s' have already been declared"_err_en_US);
- context().SetError(symbol);
+ if (!context().HasError(symbol)) {
+ Say(name,
+ "The codimensions of '%s' have already been declared"_err_en_US);
+ context().SetError(symbol);
+ }
} else {
details->set_coshape(coarraySpec());
}
@@ -3913,7 +3924,7 @@ bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
CHECK(!interfaceName_);
return true;
}
-void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &stmt) {
+void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
interfaceName_ = nullptr;
}
bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
@@ -4702,9 +4713,11 @@ void DeclarationVisitor::SetType(
} else if (!symbol.test(Symbol::Flag::Implicit)) {
SayWithDecl(
name, symbol, "The type of '%s' has already been declared"_err_en_US);
+ context().SetError(symbol);
} else if (type != *prevType) {
SayWithDecl(name, symbol,
"The type of '%s' has already been implicitly declared"_err_en_US);
+ context().SetError(symbol);
} else {
symbol.set(Symbol::Flag::Implicit, false);
}
@@ -5697,17 +5710,21 @@ void DeclarationVisitor::PointerInitialization(
const parser::Name &name, const parser::InitialDataTarget &target) {
if (name.symbol) {
Symbol &ultimate{name.symbol->GetUltimate()};
- if (IsPointer(ultimate)) {
- if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
- CHECK(!details->init());
- Walk(target);
- if (MaybeExpr expr{EvaluateExpr(target)}) {
- CheckInitialDataTarget(ultimate, *expr, target.value().source);
- details->set_init(std::move(*expr));
+ if (!context().HasError(ultimate)) {
+ if (IsPointer(ultimate)) {
+ if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
+ CHECK(!details->init());
+ Walk(target);
+ if (MaybeExpr expr{EvaluateExpr(target)}) {
+ CheckInitialDataTarget(ultimate, *expr, target.value().source);
+ details->set_init(std::move(*expr));
+ }
}
+ } else {
+ Say(name,
+ "'%s' is not a pointer but is initialized like one"_err_en_US);
+ context().SetError(ultimate);
}
- } else {
- Say(name, "'%s' is not a pointer but is initialized like one"_err_en_US);
}
}
}
@@ -5715,22 +5732,25 @@ void DeclarationVisitor::PointerInitialization(
const parser::Name &name, const parser::ProcPointerInit &target) {
if (name.symbol) {
Symbol &ultimate{name.symbol->GetUltimate()};
- if (IsProcedurePointer(ultimate)) {
- auto &details{ultimate.get<ProcEntityDetails>()};
- CHECK(!details.init());
- Walk(target);
- if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
- CheckInitialProcTarget(ultimate, *targetName, name.source);
- if (targetName->symbol) {
- details.set_init(*targetName->symbol);
+ if (!context().HasError(ultimate)) {
+ if (IsProcedurePointer(ultimate)) {
+ auto &details{ultimate.get<ProcEntityDetails>()};
+ CHECK(!details.init());
+ Walk(target);
+ if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
+ CheckInitialProcTarget(ultimate, *targetName, name.source);
+ if (targetName->symbol) {
+ details.set_init(*targetName->symbol);
+ }
+ } else {
+ details.set_init(nullptr); // explicit NULL()
}
} else {
- details.set_init(nullptr); // explicit NULL()
+ Say(name,
+ "'%s' is not a procedure pointer but is initialized "
+ "like one"_err_en_US);
+ context().SetError(ultimate);
}
- } else {
- Say(name,
- "'%s' is not a procedure pointer but is initialized "
- "like one"_err_en_US);
}
}
}
diff --git a/flang/test/Semantics/resolve91.f90 b/flang/test/Semantics/resolve91.f90
new file mode 100644
index 000000000000..f55ca865cf3c
--- /dev/null
+++ b/flang/test/Semantics/resolve91.f90
@@ -0,0 +1,46 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Tests for duplicate definitions and initializations, mostly of procedures
+module m
+ procedure(real), pointer :: p
+ !ERROR: The interface for procedure 'p' has already been declared
+ procedure(integer), pointer :: p
+end
+
+module m1
+ real, dimension(:), pointer :: realArray => null()
+ !ERROR: The type of 'realarray' has already been declared
+ real, dimension(:), pointer :: realArray => localArray
+end module m1
+
+module m2
+ interface
+ subroutine sub()
+ end subroutine sub
+ end interface
+
+ procedure(sub), pointer :: p1 => null()
+ !ERROR: The interface for procedure 'p1' has already been declared
+ procedure(sub), pointer :: p1 => null()
+
+end module m2
+
+module m3
+ interface
+ real function fun()
+ end function fun
+ end interface
+
+ procedure(fun), pointer :: f1 => null()
+ !ERROR: The interface for procedure 'f1' has already been declared
+ procedure(fun), pointer :: f1 => null()
+
+end module m3
+
+module m4
+ real, dimension(:), pointer :: localArray => null()
+ type :: t2
+ real, dimension(:), pointer :: realArray => null()
+ !ERROR: Component 'realarray' is already declared in this derived type
+ real, dimension(:), pointer :: realArray => localArray
+ end type
+end module m4
More information about the flang-commits
mailing list