mirror of
https://github.com/capstone-engine/llvm-capstone.git
synced 2025-01-14 12:12:07 +00:00
[flang] Fix CHECK() on wa22 by implementing PGI language extension
Original-commit: flang-compiler/f18@03fcb58977 Reviewed-on: https://github.com/flang-compiler/f18/pull/287 Tree-same-pre-rewrite: false
This commit is contained in:
parent
2f12ee4f52
commit
4417443be9
@ -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
|
||||
--------------------------------------------
|
||||
|
@ -16,7 +16,6 @@
|
||||
#include "expression.h"
|
||||
#include "type.h"
|
||||
#include "../parser/characters.h"
|
||||
#include <algorithm>
|
||||
|
||||
namespace Fortran::evaluate {
|
||||
|
||||
@ -112,7 +111,7 @@ Constant<SubscriptInteger> ConstantBase<RESULT, VALUE>::SHAPE() const {
|
||||
return ShapeAsConstant(shape_);
|
||||
}
|
||||
|
||||
// Constant<Type<TypeCategory::Character, KIND> specializations
|
||||
// Constant<Type<TypeCategory::Character, KIND> specializations
|
||||
template<int KIND>
|
||||
Constant<Type<TypeCategory::Character, KIND>>::Constant(const ScalarValue &str)
|
||||
: values_{str}, length_{static_cast<std::int64_t>(values_.size())} {}
|
||||
@ -130,8 +129,12 @@ Constant<Type<TypeCategory::Character, KIND>>::Constant(std::int64_t len,
|
||||
static_cast<typename ScalarValue::value_type>(' '));
|
||||
std::int64_t at{0};
|
||||
for (const auto &str : strings) {
|
||||
values_.replace(
|
||||
at, std::min(length_, static_cast<std::int64_t>(str.size())), str);
|
||||
auto strLen{static_cast<std::int64_t>(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<std::int64_t>(values_.size()));
|
||||
|
@ -36,7 +36,6 @@ struct Options {
|
||||
|
||||
bool isFixedForm{false};
|
||||
int fixedFormColumns{72};
|
||||
bool isStrictlyStandard{false};
|
||||
LanguageFeatureControl features;
|
||||
Encoding encoding{Encoding::UTF8};
|
||||
std::vector<std::string> searchDirectories;
|
||||
|
@ -1130,13 +1130,23 @@ std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
|
||||
|
||||
// Array constructors
|
||||
|
||||
struct ArrayConstructorContext {
|
||||
class ArrayConstructorContext {
|
||||
public:
|
||||
ArrayConstructorContext(
|
||||
ExpressionAnalysisContext &c, std::optional<DynamicTypeWithLength> &t)
|
||||
: exprContext_{c}, type_{t} {}
|
||||
ArrayConstructorContext(const ArrayConstructorContext &) = default;
|
||||
void Push(MaybeExpr &&);
|
||||
void Add(const parser::AcValue &);
|
||||
ExpressionAnalysisContext &exprContext;
|
||||
std::optional<DynamicTypeWithLength> &type;
|
||||
bool typesMustMatch{false};
|
||||
ArrayConstructorValues<SomeType> values;
|
||||
std::optional<DynamicTypeWithLength> &type() const { return type_; }
|
||||
const ArrayConstructorValues<SomeType> &values() { return values_; }
|
||||
|
||||
private:
|
||||
ExpressionAnalysisContext &exprContext_;
|
||||
std::optional<DynamicTypeWithLength> &type_;
|
||||
bool explicitType_{type_.has_value()};
|
||||
std::optional<std::int64_t> constantLength_;
|
||||
ArrayConstructorValues<SomeType> 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<const DynamicType &>(*type) ==
|
||||
CHECK(!explicitType_);
|
||||
type_ = std::move(xType);
|
||||
constantLength_ = ToInt64(type_->length);
|
||||
values_.Push(std::move(*x));
|
||||
} else if (!explicitType_) {
|
||||
if (static_cast<const DynamicType &>(*type_) ==
|
||||
static_cast<const DynamicType &>(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<Expr<IntType>> lower{
|
||||
GetSpecificIntExpr<IntType::kind>(
|
||||
exprContext, std::get<0>(triplet.t))};
|
||||
exprContext_, std::get<0>(triplet.t))};
|
||||
std::optional<Expr<IntType>> upper{
|
||||
GetSpecificIntExpr<IntType::kind>(
|
||||
exprContext, std::get<1>(triplet.t))};
|
||||
exprContext_, std::get<1>(triplet.t))};
|
||||
std::optional<Expr<IntType>> stride{
|
||||
GetSpecificIntExpr<IntType::kind>(
|
||||
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<IntType>{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<SomeType>{
|
||||
Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{name}}}});
|
||||
values.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
||||
values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
||||
std::move(*upper), std::move(*stride),
|
||||
std::move(nested.values)});
|
||||
std::move(nested.values_)});
|
||||
}
|
||||
},
|
||||
[&](const common::Indirection<parser::Expr> &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<std::optional<parser::IntegerTypeSpec>>(
|
||||
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<Expr<IntType>> lower{
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.lower)};
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext_, bounds.lower)};
|
||||
std::optional<Expr<IntType>> upper{
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.upper)};
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext_, bounds.upper)};
|
||||
std::optional<Expr<IntType>> stride{
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.step)};
|
||||
ArrayConstructorContext nested{exprContext, type, typesMustMatch};
|
||||
GetSpecificIntExpr<IntType::kind>(exprContext_, bounds.step)};
|
||||
ArrayConstructorContext nested{*this};
|
||||
for (const auto &value :
|
||||
std::get<std::list<parser::AcValue>>(impliedDo->t)) {
|
||||
nested.Add(value);
|
||||
@ -1247,12 +1278,12 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
|
||||
if (!stride.has_value()) {
|
||||
stride = Expr<IntType>{1};
|
||||
}
|
||||
values.Push(ImpliedDo<SomeType>{name, std::move(*lower),
|
||||
values_.Push(ImpliedDo<SomeType>{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<DynamicTypeWithLength> 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;
|
||||
|
@ -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<std::string> searchDirectories_;
|
||||
std::string moduleDirectory_{"."s};
|
||||
bool warnOnNonstandardUsage_{false};
|
||||
bool warningsAreErrors_{false};
|
||||
const evaluate::IntrinsicProcTable intrinsics_;
|
||||
Scope globalScope_;
|
||||
|
@ -83,6 +83,7 @@ struct DriverOptions {
|
||||
std::vector<std::string> 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) {
|
||||
|
Loading…
x
Reference in New Issue
Block a user