hold true for definable arguments.
* Assignment of `LOGICAL` to `INTEGER` and vice versa (but not other types) is
allowed. The values are normalized.
+* Static initialization of `LOGICAL` with `INTEGER` is allowed in `DATA` statements
+ and object initializers.
+ The results are *not* normalized to canonical `.TRUE.`/`.FALSE.`.
+ Static initialization of `INTEGER` with `LOGICAL` is also permitted.
* An effectively empty source file (no program unit) is accepted and
produces an empty relocatable output file.
* A `RETURN` statement may appear in a main program.
template <int BITS, bool IS_LIKE_C = true> class Logical {
public:
static constexpr int bits{BITS};
+ using Word = Integer<bits>;
// Module ISO_C_BINDING kind C_BOOL is LOGICAL(KIND=1) and must have
// C's bit representation (.TRUE. -> 1, .FALSE. -> 0).
template <int B, bool C>
constexpr Logical(Logical<B, C> x) : word_{Represent(x.IsTrue())} {}
constexpr Logical(bool truth) : word_{Represent(truth)} {}
+ // A raw word, for DATA initialization
+ constexpr Logical(Word &&w) : word_{std::move(w)} {}
template <int B, bool C> constexpr Logical &operator=(Logical<B, C> x) {
word_ = Represent(x.IsTrue());
return *this;
}
+ Word word() const { return word_; }
+ bool IsCanonical() const {
+ return word_ == canonicalFalse || word_ == canonicalTrue;
+ }
+
// Fortran actually has only .EQV. & .NEQV. relational operations
// for LOGICAL, but this template class supports more so that
// it can be used with the STL for sorting and as a key type for
}
private:
- using Word = Integer<bits>;
- static constexpr Word canonicalTrue{IsLikeC ? -std::uint64_t{1} : 1};
+ static constexpr Word canonicalTrue{IsLikeC ? 1 : -std::uint64_t{1}};
static constexpr Word canonicalFalse{0};
static constexpr Word Represent(bool x) {
return x ? canonicalTrue : canonicalFalse;
}
- constexpr Logical(const Word &w) : word_{w} {}
Word word_;
};
}
}
+// Nonstandard conversions of constants (integer->logical, logical->integer)
+// that can appear in DATA statements as an extension.
+std::optional<Expr<SomeType>> DataConstantConversionExtension(
+ FoldingContext &, const DynamicType &, const Expr<SomeType> &);
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
return defaultKinds_.doublePrecisionKind();
}
int quadPrecisionKind() const { return defaultKinds_.quadPrecisionKind(); }
- bool IsEnabled(common::LanguageFeature) const;
- bool ShouldWarn(common::LanguageFeature) const;
+ bool IsEnabled(common::LanguageFeature feature) const {
+ return languageFeatures_.IsEnabled(feature);
+ }
+ bool ShouldWarn(common::LanguageFeature feature) const {
+ return languageFeatures_.ShouldWarn(feature);
+ }
const std::optional<parser::CharBlock> &location() const { return location_; }
const std::vector<std::string> &searchDirectories() const {
return searchDirectories_;
// Converts, folds, and then checks type, rank, and shape of an
// initialization expression for a named constant, a non-pointer
-// variable static initializatio, a component default initializer,
+// variable static initialization, a component default initializer,
// a type parameter default value, or instantiated type parameter value.
std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
Expr<SomeType> &&x, FoldingContext &context,
if (auto symTS{
characteristics::TypeAndShape::Characterize(symbol, context)}) {
auto xType{x.GetType()};
- if (auto converted{ConvertToType(symTS->type(), std::move(x))}) {
+ auto converted{ConvertToType(symTS->type(), Expr<SomeType>{x})};
+ if (!converted &&
+ symbol.owner().context().IsEnabled(
+ common::LanguageFeature::LogicalIntegerAssignment)) {
+ converted = DataConstantConversionExtension(context, symTS->type(), x);
+ if (converted &&
+ symbol.owner().context().ShouldWarn(
+ common::LanguageFeature::LogicalIntegerAssignment)) {
+ context.messages().Say(
+ "nonstandard usage: initialization of %s with %s"_en_US,
+ symTS->type().AsFortran(), x.GetType().value().AsFortran());
+ }
+ }
+ if (converted) {
auto folded{Fold(context, std::move(*converted))};
if (IsActuallyConstant(folded)) {
int symRank{GetRank(symTS->shape())};
} else if constexpr (Result::category == TypeCategory::Character) {
o << Result::kind << '_' << parser::QuoteCharacterLiteral(value, true);
} else if constexpr (Result::category == TypeCategory::Logical) {
- if (value.IsTrue()) {
- o << ".true.";
+ if (!value.IsCanonical()) {
+ o << "transfer(" << value.word().ToInt64() << "_8,.false._"
+ << Result::kind << ')';
+ } else if (value.IsTrue()) {
+ o << ".true." << '_' << Result::kind;
} else {
- o << ".false.";
+ o << ".false." << '_' << Result::kind;
}
- o << '_' << Result::kind;
} else {
StructureConstructor{result_.derivedTypeSpec(), value}.AsFortran(o);
}
return std::visit([](const auto &y) { return GetLastPointerSymbol(y); }, x.u);
}
+template <TypeCategory TO, TypeCategory FROM>
+static std::optional<Expr<SomeType>> DataConstantConversionHelper(
+ FoldingContext &context, const DynamicType &toType,
+ const Expr<SomeType> &expr) {
+ DynamicType sizedType{FROM, toType.kind()};
+ if (auto sized{
+ Fold(context, ConvertToType(sizedType, Expr<SomeType>{expr}))}) {
+ if (const auto *someExpr{UnwrapExpr<Expr<SomeKind<FROM>>>(*sized)}) {
+ return std::visit(
+ [](const auto &w) -> std::optional<Expr<SomeType>> {
+ using FromType = typename std::decay_t<decltype(w)>::Result;
+ static constexpr int kind{FromType::kind};
+ if constexpr (IsValidKindOfIntrinsicType(TO, kind)) {
+ if (const auto *fromConst{UnwrapExpr<Constant<FromType>>(w)}) {
+ using FromWordType = typename FromType::Scalar;
+ using LogicalType = value::Logical<FromWordType::bits>;
+ using ElementType =
+ std::conditional_t<TO == TypeCategory::Logical, LogicalType,
+ typename LogicalType::Word>;
+ std::vector<ElementType> values;
+ auto at{fromConst->lbounds()};
+ auto shape{fromConst->shape()};
+ for (auto n{GetSize(shape)}; n-- > 0;
+ fromConst->IncrementSubscripts(at)) {
+ auto elt{fromConst->At(at)};
+ if constexpr (TO == TypeCategory::Logical) {
+ values.emplace_back(std::move(elt));
+ } else {
+ values.emplace_back(elt.word());
+ }
+ }
+ return {AsGenericExpr(AsExpr(Constant<Type<TO, kind>>{
+ std::move(values), std::move(shape)}))};
+ }
+ }
+ return std::nullopt;
+ },
+ someExpr->u);
+ }
+ }
+ return std::nullopt;
+}
+
+std::optional<Expr<SomeType>> DataConstantConversionExtension(
+ FoldingContext &context, const DynamicType &toType,
+ const Expr<SomeType> &expr0) {
+ Expr<SomeType> expr{Fold(context, Expr<SomeType>{expr0})};
+ if (!IsActuallyConstant(expr)) {
+ return std::nullopt;
+ }
+ if (auto fromType{expr.GetType()}) {
+ if (toType.category() == TypeCategory::Logical &&
+ fromType->category() == TypeCategory::Integer) {
+ return DataConstantConversionHelper<TypeCategory::Logical,
+ TypeCategory::Integer>(context, toType, expr);
+ }
+ if (toType.category() == TypeCategory::Integer &&
+ fromType->category() == TypeCategory::Logical) {
+ return DataConstantConversionHelper<TypeCategory::Integer,
+ TypeCategory::Logical>(context, toType, expr);
+ }
+ }
+ return std::nullopt;
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
return {std::make_pair(std::move(*converted), true)};
}
}
+ SemanticsContext &context{exprAnalyzer_.context()};
+ if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
+ if (MaybeExpr converted{evaluate::DataConstantConversionExtension(
+ exprAnalyzer_.GetFoldingContext(), type, expr)}) {
+ if (context.ShouldWarn(
+ common::LanguageFeature::LogicalIntegerAssignment)) {
+ context.Say("nonstandard usage: initialization of %s with %s"_en_US,
+ type.AsFortran(), expr.GetType().value().AsFortran());
+ }
+ return {std::make_pair(std::move(*converted), false)};
+ }
+ }
return std::nullopt;
}
return defaultKinds_.GetDefaultKind(category);
}
-bool SemanticsContext::IsEnabled(common::LanguageFeature feature) const {
- return languageFeatures_.IsEnabled(feature);
-}
-
-bool SemanticsContext::ShouldWarn(common::LanguageFeature feature) const {
- return languageFeatures_.ShouldWarn(feature);
-}
-
const DeclTypeSpec &SemanticsContext::MakeNumericType(
TypeCategory category, int kind) {
if (kind == 0) {
data jx/'abc'/
!ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
data jx/t1()/
- !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
- data jx/.false./
!ERROR: DATA statement value 'jy' for 'jx' is not a constant
data jx/jy/
end subroutine
--- /dev/null
+! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+! Verify initialization extension: integer with logical, logical with integer
+! CHECK: d (InDataStmt) size=20 offset=40: ObjectEntity type: LOGICAL(4) shape: 1_8:5_8 init:[LOGICAL(4)::transfer(-2_8,.false._4),transfer(-1_8,.false._4),.false._4,.true._4,transfer(2_8,.false._4)]
+! CHECK: j (InDataStmt) size=8 offset=60: ObjectEntity type: INTEGER(4) shape: 1_8:2_8 init:[INTEGER(4)::0_4,1_4]
+! CHECK: x, PARAMETER size=20 offset=0: ObjectEntity type: LOGICAL(4) shape: 1_8:5_8 init:[LOGICAL(4)::transfer(-2_8,.false._4),transfer(-1_8,.false._4),.false._4,.true._4,transfer(2_8,.false._4)]
+! CHECK: y, PARAMETER size=20 offset=20: ObjectEntity type: INTEGER(4) shape: 1_8:5_8 init:[INTEGER(4)::-2_4,-1_4,0_4,1_4,2_4]
+program main
+ logical, parameter :: x(5) = [ -2, -1, 0, 1, 2 ]
+ integer, parameter :: y(5) = x
+ logical :: d(5)
+ integer :: j(2)
+ data d / -2, -1, 0, 1, 2 /
+ data j / .false., .true. /
+end
+
projects / platform / upstream / llvm.git / commitdiff