diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -74,6 +74,11 @@ `CFI_section`, `CFI_setpointer` or `CFI_allocate`, the lower bound on that dimension will be set to 1 for consistency with the `LBOUND()` intrinsic function. +* `-2147483648_4` is, strictly speaking, a non-conforming literal + constant on a machine with 32-bit two's-complement integers as + kind 4, because the grammar of Fortran expressions parses it as a + negation of a literal constant, not a negative literal constant. + This compiler accepts it with a portability warning. ## Extensions, deletions, and legacy features supported by default diff --git a/flang/include/flang/Evaluate/common.h b/flang/include/flang/Evaluate/common.h --- a/flang/include/flang/Evaluate/common.h +++ b/flang/include/flang/Evaluate/common.h @@ -259,6 +259,11 @@ std::size_t maxAlignment() const { return maxAlignment_; } const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; } const IntrinsicProcTable &intrinsics() const { return intrinsics_; } + bool inModuleFile() const { return inModuleFile_; } + FoldingContext &set_inModuleFile(bool yes = true) { + inModuleFile_ = yes; + return *this; + } ConstantSubscript &StartImpliedDo(parser::CharBlock, ConstantSubscript = 1); std::optional GetImpliedDo(parser::CharBlock) const; @@ -282,6 +287,7 @@ static constexpr bool bigEndian_{false}; // TODO: configure for target static constexpr std::size_t maxAlignment_{8}; // TODO: configure for target const semantics::DerivedTypeSpec *pdtInstance_{nullptr}; + bool inModuleFile_{false}; std::map impliedDos_; }; diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -255,7 +255,7 @@ int IntegerTypeSpecKind(const parser::IntegerTypeSpec &); private: - MaybeExpr Analyze(const parser::IntLiteralConstant &); + MaybeExpr Analyze(const parser::IntLiteralConstant &, bool negated = false); MaybeExpr Analyze(const parser::RealLiteralConstant &); MaybeExpr Analyze(const parser::ComplexPart &); MaybeExpr Analyze(const parser::ComplexLiteralConstant &); @@ -308,7 +308,8 @@ const std::optional &, int defaultKind); template MaybeExpr ExprOrVariable(const PARSED &, parser::CharBlock source); - template MaybeExpr IntLiteralConstant(const PARSED &); + template + MaybeExpr IntLiteralConstant(const PARSED &, bool negated = false); MaybeExpr AnalyzeString(std::string &&, int kind); std::optional> AsSubscript(MaybeExpr &&); std::optional> TripletPart( diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -170,6 +170,8 @@ const Scope &FindScope(parser::CharBlock) const; Scope &FindScope(parser::CharBlock); + bool IsInModuleFile(parser::CharBlock) const; + const ConstructStack &constructStack() const { return constructStack_; } template void PushConstruct(const N &node) { constructStack_.emplace_back(&node); diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -1823,7 +1823,22 @@ return Expr{Constant{quotAndRem.quotient}}; } else { auto quotient{folded->first.Divide(folded->second, context.rounding())}; - RealFlagWarnings(context, quotient.flags, "division"); + // Don't warn about -1./0., 0./0., or 1./0. from a module file + // they are interpreted as canonical Fortran representations of -Inf, + // NaN, and Inf respectively. + bool isCanonicalNaNOrInf{false}; + if constexpr (T::category == TypeCategory::Real) { + if (folded->second.IsZero() && context.inModuleFile()) { + using IntType = typename T::Scalar::Word; + auto intNumerator{folded->first.template ToInteger()}; + isCanonicalNaNOrInf = intNumerator.flags == RealFlags{} && + intNumerator.value >= IntType{-1} && + intNumerator.value <= IntType{1}; + } + } + if (!isCanonicalNaNOrInf) { + RealFlagWarnings(context, quotient.flags, "division"); + } if (context.flushSubnormalsToZero()) { quotient.value = quotient.value.FlushSubnormalToZero(); } diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -423,8 +423,21 @@ template Result Test() { if (T::kind >= kind) { const char *p{digits.begin()}; - auto value{T::Scalar::Read(p, 10, true /*signed*/)}; - if (!value.overflow) { + using Int = typename T::Scalar; + typename Int::ValueWithOverflow num{0, false}; + if (isNegated) { + auto unsignedNum{Int::Read(p, 10, false /*unsigned*/)}; + num.value = unsignedNum.value.Negate().value; + num.overflow = unsignedNum.overflow || num.value > Int{0}; + if (!num.overflow && num.value.Negate().overflow && + !analyzer.context().IsInModuleFile(digits)) { + analyzer.Say(digits, + "negated maximum INTEGER(KIND=%d) literal"_port_en_US, T::kind); + } + } else { + num = Int::Read(p, 10, true /*signed*/); + } + if (!num.overflow) { if (T::kind > kind) { if (!isDefaultKind || !analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) { @@ -438,7 +451,7 @@ } } return Expr{ - Expr{Expr{Constant{std::move(value.value)}}}}; + Expr{Expr{Constant{std::move(num.value)}}}}; } } return std::nullopt; @@ -447,17 +460,19 @@ parser::CharBlock digits; int kind; bool isDefaultKind; + bool isNegated; }; template -MaybeExpr ExpressionAnalyzer::IntLiteralConstant(const PARSED &x) { +MaybeExpr ExpressionAnalyzer::IntLiteralConstant( + const PARSED &x, bool isNegated) { const auto &kindParam{std::get>(x.t)}; bool isDefaultKind{!kindParam}; int kind{AnalyzeKindParam(kindParam, GetDefaultKind(TypeCategory::Integer))}; if (CheckIntrinsicKind(TypeCategory::Integer, kind)) { auto digits{std::get(x.t)}; if (MaybeExpr result{common::SearchTypes( - IntTypeVisitor{*this, digits, kind, isDefaultKind})}) { + IntTypeVisitor{*this, digits, kind, isDefaultKind, isNegated})}) { return result; } else if (isDefaultKind) { Say(digits, @@ -471,10 +486,11 @@ return std::nullopt; } -MaybeExpr ExpressionAnalyzer::Analyze(const parser::IntLiteralConstant &x) { +MaybeExpr ExpressionAnalyzer::Analyze( + const parser::IntLiteralConstant &x, bool isNegated) { auto restorer{ GetContextualMessages().SetLocation(std::get(x.t))}; - return IntLiteralConstant(x); + return IntLiteralConstant(x, isNegated); } MaybeExpr ExpressionAnalyzer::Analyze( @@ -2595,6 +2611,13 @@ } MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Negate &x) { + if (const auto *litConst{ + std::get_if(&x.v.value().u)}) { + if (const auto *intConst{ + std::get_if(&litConst->u)}) { + return Analyze(*intConst, true); + } + } return NumericUnaryHelper(*this, NumericOperator::Subtract, x); } @@ -3462,10 +3485,10 @@ std::optional msg; if (lhs == TypeCategory::Integer && rhs == TypeCategory::Logical) { // allow assignment to LOGICAL from INTEGER as a legacy extension - msg = "nonstandard usage: assignment of LOGICAL to INTEGER"_port_en_US; + msg = "assignment of LOGICAL to INTEGER"_port_en_US; } else if (lhs == TypeCategory::Logical && rhs == TypeCategory::Integer) { // ... and assignment to LOGICAL from INTEGER - msg = "nonstandard usage: assignment of INTEGER to LOGICAL"_port_en_US; + msg = "assignment of INTEGER to LOGICAL"_port_en_US; } else { return false; } diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -1018,9 +1018,13 @@ if (!pair.second) { return nullptr; } + // Process declarations from the module file Symbol &modSymbol{*pair.first->second}; modSymbol.set(Symbol::Flag::ModFile); + bool wasInModuleFile{context_.foldingContext().inModuleFile()}; + context_.foldingContext().set_inModuleFile(true); ResolveNames(context_, parseTree, topScope); + context_.foldingContext().set_inModuleFile(wasInModuleFile); CHECK(modSymbol.has()); CHECK(modSymbol.test(Symbol::Flag::ModFile)); if (isIntrinsic.value_or(false)) { diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -356,6 +356,16 @@ } } +bool SemanticsContext::IsInModuleFile(parser::CharBlock source) const { + for (const Scope *scope{&FindScope(source)}; !scope->IsGlobal(); + scope = &scope->parent()) { + if (scope->IsModuleFile()) { + return true; + } + } + return false; +} + void SemanticsContext::PopConstruct() { CHECK(!constructStack_.empty()); constructStack_.pop_back(); diff --git a/flang/test/Semantics/dosemantics03.f90 b/flang/test/Semantics/dosemantics03.f90 --- a/flang/test/Semantics/dosemantics03.f90 +++ b/flang/test/Semantics/dosemantics03.f90 @@ -215,7 +215,7 @@ ! Invalid initial expression !ERROR: Integer literal is too large for INTEGER(KIND=4) - DO ivar = -2147483648_4, 10, 3 + DO ivar = -2147483649_4, 10, 3 PRINT *, "ivar is: ", ivar END DO @@ -257,7 +257,7 @@ ! Invalid final expression !ERROR: Integer literal is too large for INTEGER(KIND=4) - DO ivar = 1, -2147483648_4, 3 + DO ivar = 1, -2147483649_4, 3 PRINT *, "ivar is: ", ivar END DO @@ -299,7 +299,7 @@ ! Invalid step expression !ERROR: Integer literal is too large for INTEGER(KIND=4) - DO ivar = 1, 10, -2147483648_4 + DO ivar = 1, 10, -2147483649_4 PRINT *, "ivar is: ", ivar END DO