From 4417443be944f7defb16c91388f5d50c7b9b6d82 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 15 Feb 2019 12:20:30 -0800 Subject: [PATCH] [flang] Fix CHECK() on wa22 by implementing PGI language extension Original-commit: flang-compiler/f18@03fcb58977878ace2cd81cd404d8f6751bd9739b Reviewed-on: https://github.com/flang-compiler/f18/pull/287 Tree-same-pre-rewrite: false --- flang/documentation/extensions.md | 3 + flang/lib/evaluate/constant.cc | 11 ++-- flang/lib/parser/parsing.h | 1 - flang/lib/semantics/expression.cc | 106 +++++++++++++++++++----------- flang/lib/semantics/semantics.h | 8 ++- flang/tools/f18/f18.cc | 6 +- 6 files changed, 89 insertions(+), 46 deletions(-) diff --git a/flang/documentation/extensions.md b/flang/documentation/extensions.md index c4fb289fe360..38fccff2da54 100644 --- a/flang/documentation/extensions.md +++ b/flang/documentation/extensions.md @@ -53,6 +53,9 @@ Extensions, deletions, and legacy features supported by default could have a label * The character `&` in column 1 in fixed form source is a variant form of continuation line. +* Character literals as elements of an array constructor without an explicit + type specifier need not have the same length; the longest literal determines + the length parameter of the implicit type, not the first. Extensions supported when enabled by options -------------------------------------------- diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc index 6bfde43f37c0..0fcf97298e03 100644 --- a/flang/lib/evaluate/constant.cc +++ b/flang/lib/evaluate/constant.cc @@ -16,7 +16,6 @@ #include "expression.h" #include "type.h" #include "../parser/characters.h" -#include namespace Fortran::evaluate { @@ -112,7 +111,7 @@ Constant ConstantBase::SHAPE() const { return ShapeAsConstant(shape_); } -// Constant specializations +// Constant specializations template Constant>::Constant(const ScalarValue &str) : values_{str}, length_{static_cast(values_.size())} {} @@ -130,8 +129,12 @@ Constant>::Constant(std::int64_t len, static_cast(' ')); std::int64_t at{0}; for (const auto &str : strings) { - values_.replace( - at, std::min(length_, static_cast(str.size())), str); + auto strLen{static_cast(str.size())}; + if (strLen > length_) { + values_.replace(at, length_, str.substr(0, length_)); + } else { + values_.replace(at, strLen, str); + } at += length_; } CHECK(at == static_cast(values_.size())); diff --git a/flang/lib/parser/parsing.h b/flang/lib/parser/parsing.h index d48f8483f27a..819bf183ca1f 100644 --- a/flang/lib/parser/parsing.h +++ b/flang/lib/parser/parsing.h @@ -36,7 +36,6 @@ struct Options { bool isFixedForm{false}; int fixedFormColumns{72}; - bool isStrictlyStandard{false}; LanguageFeatureControl features; Encoding encoding{Encoding::UTF8}; std::vector searchDirectories; diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index d5b149a001fb..04228327d243 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1130,13 +1130,23 @@ std::optional>> GetSpecificIntExpr( // Array constructors -struct ArrayConstructorContext { +class ArrayConstructorContext { +public: + ArrayConstructorContext( + ExpressionAnalysisContext &c, std::optional &t) + : exprContext_{c}, type_{t} {} + ArrayConstructorContext(const ArrayConstructorContext &) = default; void Push(MaybeExpr &&); void Add(const parser::AcValue &); - ExpressionAnalysisContext &exprContext; - std::optional &type; - bool typesMustMatch{false}; - ArrayConstructorValues values; + std::optional &type() const { return type_; } + const ArrayConstructorValues &values() { return values_; } + +private: + ExpressionAnalysisContext &exprContext_; + std::optional &type_; + bool explicitType_{type_.has_value()}; + std::optional constantLength_; + ArrayConstructorValues values_; }; void ArrayConstructorContext::Push(MaybeExpr &&x) { @@ -1150,30 +1160,49 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) { xType.length = std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u); } - if (!type.has_value()) { + if (!type_.has_value()) { // If there is no explicit type-spec in an array constructor, the type // of the array is the declared type of all of the elements, which must - // be well-defined. + // be well-defined and all match. // TODO: Possible language extension: use the most general type of // the values as the type of a numeric constructed array, convert all // of the other values to that type. Alternative: let the first value // determine the type, and convert the others to that type. // TODO pmk: better type compatibility checks for derived types - type = std::move(xType); - values.Push(std::move(*x)); - } else if (typesMustMatch) { - if (static_cast(*type) == + CHECK(!explicitType_); + type_ = std::move(xType); + constantLength_ = ToInt64(type_->length); + values_.Push(std::move(*x)); + } else if (!explicitType_) { + if (static_cast(*type_) == static_cast(xType)) { - values.Push(std::move(*x)); + values_.Push(std::move(*x)); + if (auto thisLen{ToInt64(xType.length)}) { + if (constantLength_.has_value()) { + if (exprContext_.context().warnOnNonstandardUsage() && + *thisLen != *constantLength_) { + exprContext_.Say( + "Character literal in array constructor without explicit type has different length than earlier element"_en_US); + } + if (*thisLen > *constantLength_) { + // Language extension (TODO pmk document) + *constantLength_ = *thisLen; + type_->length = std::move(xType.length); + } + } else { + constantLength_ = *thisLen; + type_->length = std::move(xType.length); + } + } } else { - exprContext.Say( + exprContext_.Say( "Values in array constructor must have the same declared type when no explicit type appears"_err_en_US); } } else { - if (auto cast{ConvertToType(*type, std::move(*x))}) { - values.Push(std::move(*cast)); + if (auto cast{ConvertToType(*type_, std::move(*x))}) { + values_.Push(std::move(*cast)); } else { - exprContext.Say( + exprContext_.Say( "Value in array constructor could not be converted to the type of the array"_err_en_US); } } @@ -1188,31 +1217,33 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) { // Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_' std::optional> lower{ GetSpecificIntExpr( - exprContext, std::get<0>(triplet.t))}; + exprContext_, std::get<0>(triplet.t))}; std::optional> upper{ GetSpecificIntExpr( - exprContext, std::get<1>(triplet.t))}; + exprContext_, std::get<1>(triplet.t))}; std::optional> stride{ GetSpecificIntExpr( - exprContext, std::get<2>(triplet.t))}; + exprContext_, std::get<2>(triplet.t))}; if (lower.has_value() && upper.has_value()) { if (!stride.has_value()) { stride = Expr{1}; } - if (!type.has_value()) { - type = DynamicTypeWithLength{IntType::GetType()}; + if (!type_.has_value()) { + type_ = DynamicTypeWithLength{IntType::GetType()}; } - ArrayConstructorContext nested{exprContext, type, typesMustMatch}; + ArrayConstructorContext nested{*this}; parser::CharBlock name; nested.Push(Expr{ Expr{Expr{ImpliedDoIndex{name}}}}); - values.Push(ImpliedDo{name, std::move(*lower), + values_.Push(ImpliedDo{name, std::move(*lower), std::move(*upper), std::move(*stride), - std::move(nested.values)}); + std::move(nested.values_)}); } }, [&](const common::Indirection &expr) { - if (MaybeExpr v{exprContext.Analyze(*expr)}) { + auto restorer{ + exprContext_.GetContextualMessages().SetLocation(expr->source)}; + if (MaybeExpr v{exprContext_.Analyze(*expr)}) { Push(std::move(*v)); } }, @@ -1225,20 +1256,20 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) { int kind{IntType::kind}; if (auto &its{std::get>( control.t)}) { - kind = IntegerTypeSpecKind(exprContext, *its); + kind = IntegerTypeSpecKind(exprContext_, *its); } - bool inserted{exprContext.AddAcImpliedDo(name, kind)}; + bool inserted{exprContext_.AddAcImpliedDo(name, kind)}; if (!inserted) { - exprContext.SayAt(name, + exprContext_.SayAt(name, "Implied DO index is active in surrounding implied DO loop and cannot have the same name"_err_en_US); } std::optional> lower{ - GetSpecificIntExpr(exprContext, bounds.lower)}; + GetSpecificIntExpr(exprContext_, bounds.lower)}; std::optional> upper{ - GetSpecificIntExpr(exprContext, bounds.upper)}; + GetSpecificIntExpr(exprContext_, bounds.upper)}; std::optional> stride{ - GetSpecificIntExpr(exprContext, bounds.step)}; - ArrayConstructorContext nested{exprContext, type, typesMustMatch}; + GetSpecificIntExpr(exprContext_, bounds.step)}; + ArrayConstructorContext nested{*this}; for (const auto &value : std::get>(impliedDo->t)) { nested.Add(value); @@ -1247,12 +1278,12 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) { if (!stride.has_value()) { stride = Expr{1}; } - values.Push(ImpliedDo{name, std::move(*lower), + values_.Push(ImpliedDo{name, std::move(*lower), std::move(*upper), std::move(*stride), - std::move(nested.values)}); + std::move(nested.values_)}); } if (inserted) { - exprContext.RemoveAcImpliedDo(name); + exprContext_.RemoveAcImpliedDo(name); } }, }, @@ -1315,14 +1346,13 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &exprContext, const parser::AcSpec &acSpec{array.v}; std::optional type{ AnalyzeTypeSpec(exprContext, acSpec.type)}; - bool typesMustMatch{!type.has_value()}; - ArrayConstructorContext context{exprContext, type, typesMustMatch}; + ArrayConstructorContext context{exprContext, type}; for (const parser::AcValue &value : acSpec.values) { context.Add(value); } if (type.has_value()) { ArrayConstructorTypeVisitor visitor{ - std::move(*type), std::move(context.values)}; + std::move(*type), std::move(context.values())}; return common::SearchTypes(std::move(visitor)); } return std::nullopt; diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h index 994ddd7f191f..b37ac6918b47 100644 --- a/flang/lib/semantics/semantics.h +++ b/flang/lib/semantics/semantics.h @@ -45,7 +45,8 @@ public: return searchDirectories_; } const std::string &moduleDirectory() const { return moduleDirectory_; } - const bool warningsAreErrors() const { return warningsAreErrors_; } + bool warnOnNonstandardUsage() const { return warnOnNonstandardUsage_; } + bool warningsAreErrors() const { return warningsAreErrors_; } const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; } Scope &globalScope() { return globalScope_; } parser::Messages &messages() { return messages_; } @@ -59,6 +60,10 @@ public: moduleDirectory_ = x; return *this; } + SemanticsContext &set_warnOnNonstandardUsage(bool x) { + warnOnNonstandardUsage_ = x; + return *this; + } SemanticsContext &set_warningsAreErrors(bool x) { warningsAreErrors_ = x; return *this; @@ -76,6 +81,7 @@ private: const common::IntrinsicTypeDefaultKinds &defaultKinds_; std::vector searchDirectories_; std::string moduleDirectory_{"."s}; + bool warnOnNonstandardUsage_{false}; bool warningsAreErrors_{false}; const evaluate::IntrinsicProcTable intrinsics_; Scope globalScope_; diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc index 29dbcc08cf77..c7b8c5b06740 100644 --- a/flang/tools/f18/f18.cc +++ b/flang/tools/f18/f18.cc @@ -83,6 +83,7 @@ struct DriverOptions { std::vector searchDirectories{"."s}; // -I dir std::string moduleDirectory{"."s}; // -module dir bool forcedForm{false}; // -Mfixed or -Mfree appeared + bool warnOnNonstandardUsage{false}; // -Mstandard bool warningsAreErrors{false}; // -Werror Fortran::parser::Encoding encoding{Fortran::parser::Encoding::UTF8}; bool parseOnly{false}; @@ -369,7 +370,7 @@ int main(int argc, char *const argv[]) { options.features.Enable( Fortran::parser::LanguageFeature::BackslashEscapes); } else if (arg == "-Mstandard") { - options.features.WarnOnAllNonstandard(); + driver.warnOnNonstandardUsage = true; } else if (arg == "-fopenmp") { options.features.Enable(Fortran::parser::LanguageFeature::OpenMP); options.predefinitions.emplace_back("_OPENMP", "201511"); @@ -480,7 +481,7 @@ int main(int argc, char *const argv[]) { } driver.encoding = options.encoding; - if (options.isStrictlyStandard) { + if (driver.warnOnNonstandardUsage) { options.features.WarnOnAllNonstandard(); } if (!options.features.IsEnabled( @@ -491,6 +492,7 @@ int main(int argc, char *const argv[]) { Fortran::semantics::SemanticsContext semanticsContext{defaultKinds}; semanticsContext.set_moduleDirectory(driver.moduleDirectory) .set_searchDirectories(driver.searchDirectories) + .set_warnOnNonstandardUsage(driver.warnOnNonstandardUsage) .set_warningsAreErrors(driver.warningsAreErrors); if (!anyFiles) {