[flang] Clean up test results

Original-commit: flang-compiler/f18@7d3180160c
Reviewed-on: https://github.com/flang-compiler/f18/pull/755
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-09-20 14:28:15 -07:00
parent d8c9b50fd6
commit 9fd72e9393
5 changed files with 91 additions and 58 deletions

View File

@ -132,12 +132,14 @@ bool IsInitialDataTarget(const Expr<SomeType> &x) {
}
// Specification expression validation (10.1.11(2), C1010)
struct CheckSpecificationExprHelper
class CheckSpecificationExprHelper
: public AnyTraverse<CheckSpecificationExprHelper,
std::optional<std::string>> {
public:
using Result = std::optional<std::string>;
using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
CheckSpecificationExprHelper() : Base{*this} {}
explicit CheckSpecificationExprHelper(const semantics::Scope &s)
: Base{*this}, scope_{s} {}
using Base::operator();
Result operator()(const ProcedureDesignator &) const {
@ -172,6 +174,12 @@ struct CheckSpecificationExprHelper
return std::nullopt;
}
}
for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) {
s = &s->parent();
if (s == &symbol.owner()) {
return std::nullopt;
}
}
return "reference to local entity '"s + symbol.name().ToString() + "'";
}
@ -179,15 +187,18 @@ struct CheckSpecificationExprHelper
// Don't look at the component symbol.
return (*this)(x.base());
}
Result operator()(const DescriptorInquiry &) const {
// Subtle: Uses of SIZE(), LBOUND(), &c. that are valid in specification
// expressions will have been converted to expressions over descriptor
// inquiries by Fold().
return std::nullopt;
}
template<typename T> Result operator()(const FunctionRef<T> &x) const {
if (const auto *symbol{x.proc().GetSymbol()}) {
if (!symbol->attrs().test(semantics::Attr::PURE)) {
return "reference to impure function '"s + symbol->name().ToString() +
"'";
} else if (symbol->owner().kind() == semantics::Scope::Kind::Subprogram) {
return "reference to internal function '"s + symbol->name().ToString() +
"'";
}
// TODO: other checks for standard module procedures
} else {
@ -196,17 +207,21 @@ struct CheckSpecificationExprHelper
return std::nullopt; // no need to check argument(s)
}
if (IsConstantExpr(x)) {
return std::nullopt; // inquiry functions may not need to check
// argument(s)
// inquiry functions may not need to check argument(s)
return std::nullopt;
}
}
return (*this)(x.arguments());
}
private:
const semantics::Scope &scope_;
};
template<typename A>
void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages) {
if (auto why{CheckSpecificationExprHelper{}(x)}) {
void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages,
const semantics::Scope &scope) {
if (auto why{CheckSpecificationExprHelper{scope}(x)}) {
std::stringstream ss;
ss << x;
messages.Say("The expression (%s) cannot be used as a "
@ -215,11 +230,11 @@ void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages) {
}
}
template void CheckSpecificationExpr(const Expr<SomeType> &,
parser::ContextualMessages &, const semantics::Scope &);
template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
parser::ContextualMessages &, const semantics::Scope &);
template void CheckSpecificationExpr(
const Expr<SomeType> &, parser::ContextualMessages &);
template void CheckSpecificationExpr(
const std::optional<Expr<SomeInteger>> &, parser::ContextualMessages &);
template void CheckSpecificationExpr(
const std::optional<Expr<SubscriptInteger>> &,
parser::ContextualMessages &);
const std::optional<Expr<SubscriptInteger>> &, parser::ContextualMessages &,
const semantics::Scope &);
}

View File

@ -24,6 +24,9 @@
namespace Fortran::parser {
class ContextualMessages;
}
namespace Fortran::semantics {
class Scope;
}
namespace Fortran::evaluate {
@ -41,13 +44,15 @@ bool IsInitialDataTarget(const Expr<SomeType> &);
// (10.1.11(2), C1010). Constant expressions are always valid
// specification expressions.
template<typename A>
void CheckSpecificationExpr(const A &, parser::ContextualMessages &);
void CheckSpecificationExpr(
const A &, parser::ContextualMessages &, const semantics::Scope &);
extern template void CheckSpecificationExpr(const Expr<SomeType> &x,
parser::ContextualMessages &, const semantics::Scope &);
extern template void CheckSpecificationExpr(
const Expr<SomeType> &x, parser::ContextualMessages &);
extern template void CheckSpecificationExpr(
const std::optional<Expr<SomeInteger>> &x, parser::ContextualMessages &);
const std::optional<Expr<SomeInteger>> &x, parser::ContextualMessages &,
const semantics::Scope &);
extern template void CheckSpecificationExpr(
const std::optional<Expr<SubscriptInteger>> &x,
parser::ContextualMessages &);
parser::ContextualMessages &, const semantics::Scope &);
}
#endif

View File

@ -21,6 +21,7 @@
#include "tools.h"
#include "type.h"
#include "../evaluate/check-expression.h"
#include "../evaluate/fold.h"
namespace Fortran::semantics {
@ -28,56 +29,61 @@ class CheckHelper {
public:
explicit CheckHelper(SemanticsContext &c) : context_{c} {}
void Check() const { Check(context_.globalScope()); }
void Check(const ParamValue &value) const {
CheckSpecExpr(value.GetExplicit());
}
void Check(const Bound &bound) const { CheckSpecExpr(bound.GetExplicit()); }
void Check(const ShapeSpec &spec) const {
void Check() { Check(context_.globalScope()); }
void Check(const ParamValue &value) { CheckSpecExpr(value.GetExplicit()); }
void Check(Bound &bound) { CheckSpecExpr(bound.GetExplicit()); }
void Check(ShapeSpec &spec) {
Check(spec.lbound());
Check(spec.ubound());
}
void Check(const ArraySpec &shape) const {
for (const auto &spec : shape) {
void Check(ArraySpec &shape) {
for (auto &spec : shape) {
Check(spec);
}
}
void Check(const DeclTypeSpec &type) const {
void Check(DeclTypeSpec &type) {
if (type.category() == DeclTypeSpec::Character) {
Check(type.characterTypeSpec().length());
} else if (const DerivedTypeSpec * spec{type.AsDerived()}) {
for (const auto &parm : spec->parameters()) {
for (auto &parm : spec->parameters()) {
Check(parm.second);
}
}
}
void Check(const Symbol &) const;
void Check(const Scope &scope) const {
for (const auto &pair : scope) {
void Check(Symbol &);
void Check(Scope &scope) {
scope_ = &scope;
for (auto &pair : scope) {
Check(*pair.second);
}
for (const Scope &child : scope.children()) {
for (Scope &child : scope.children()) {
Check(child);
}
}
private:
template<typename A> void CheckSpecExpr(const A &x) const {
evaluate::CheckSpecificationExpr(x, messages_);
template<typename A> void CheckSpecExpr(A &x) {
x = Fold(foldingContext_, std::move(x));
evaluate::CheckSpecificationExpr(x, messages_, DEREF(scope_));
}
template<typename A> void CheckSpecExpr(const A &x) {
evaluate::CheckSpecificationExpr(x, messages_, DEREF(scope_));
}
SemanticsContext &context_;
parser::ContextualMessages &messages_{context_.foldingContext().messages()};
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
parser::ContextualMessages &messages_{foldingContext_.messages()};
const Scope *scope_{nullptr};
};
void CheckHelper::Check(const Symbol &symbol) const {
void CheckHelper::Check(Symbol &symbol) {
if (context_.HasError(symbol) || symbol.has<UseDetails>() ||
symbol.has<HostAssocDetails>()) {
return;
}
auto save{messages_.SetLocation(symbol.name())};
context_.set_location(symbol.name());
if (const DeclTypeSpec * type{symbol.GetType()}) {
if (DeclTypeSpec * type{symbol.GetType()}) {
Check(*type);
}
if (IsAssumedLengthCharacterFunction(symbol)) { // C723
@ -104,7 +110,7 @@ void CheckHelper::Check(const Symbol &symbol) const {
}
}
}
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
Check(object->shape());
Check(object->coshape());
}

View File

@ -141,13 +141,7 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
} else {
CHECK(std::holds_alternative<const Symbol *>(ref.u));
if (symbol.has<semantics::SubprogramNameDetails>()) {
// Call to internal function in specification expression
Say("cannot call function '%s' in this context"_err_en_US,
symbol.name());
} else {
return Expr<SomeType>{ProcedureDesignator{symbol}};
}
return Expr<SomeType>{ProcedureDesignator{symbol}};
}
} else if (auto dyType{DynamicType::From(symbol)}) {
return TypedWrapper<Designator, DataRef>(*dyType, std::move(ref));
@ -1503,13 +1497,6 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd,
return std::nullopt;
}
}
if (symbol.has<semantics::SubprogramNameDetails>()) {
// Forward reference to internal function in specification
// expression
Say("Cannot call function '%s' in this context"_err_en_US,
symbol.name());
return std::nullopt;
}
if (const auto *scope{symbol.scope()}) {
if (scope->sourceRange().Contains(n.source)) {
if (symbol.attrs().test(
@ -2223,6 +2210,20 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
}
}
}
if (const Symbol *symbol{proc.GetSymbol()}) {
if (const auto *details{symbol->detailsIf<semantics::SubprogramNameDetails>()}) {
if (details->kind() == semantics::SubprogramKind::Module) {
Say("The module function '%s' must have been previously defined "
"when referenced in a specification expression"_err_en_US,
symbol->name());
} else {
Say("The internal function '%s' cannot be referenced in "
"a specification expression"_err_en_US,
symbol->name());
}
return std::nullopt;
}
}
return std::nullopt;
}

View File

@ -31,9 +31,9 @@ module m
end interface
integer :: coarray[*]
contains
pure integer function modulefunc(n)
pure integer function modulefunc1(n)
integer, value :: n
modulefunc = n
modulefunc1 = n
end function
subroutine test(out, optional)
!ERROR: The expression (foo()) cannot be used as a specification expression (reference to impure function 'foo')
@ -41,7 +41,7 @@ module m
integer :: local
!ERROR: The expression (local) cannot be used as a specification expression (reference to local entity 'local')
type(t(local)) :: x2
!ERROR: Cannot call function 'internal' in this context
!ERROR: The internal function 'internal' cannot be referenced in a specification expression
type(t(internal(0))) :: x3
integer, intent(out) :: out
!ERROR: The expression (out) cannot be used as a specification expression (reference to INTENT(OUT) dummy argument 'out')
@ -54,11 +54,17 @@ module m
!ERROR: The expression (coarray[1_8]) cannot be used as a specification expression (coindexed reference)
type(t(coarray[1])) :: x7
type(t(kind(foo()))) :: x101 ! ok
type(t(modulefunc(0))) :: x102 ! ok
type(t(modulefunc1(0))) :: x102 ! ok
!ERROR: The module function 'modulefunc2' must have been previously defined when referenced in a specification expression
type(t(modulefunc2(0))) :: x103 ! ok
contains
pure integer function internal(n)
integer, value :: n
internal = n
end function
end subroutine
pure integer function modulefunc2(n)
integer, value :: n
modulefunc2 = n
end function
end module