diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -287,6 +287,9 @@ bool InitDesignator(const SomeExpr &); // Initializes a single object. bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator); + // If the returned flag is true, emit a warning about CHARACTER misusage. + std::optional> ConvertElement( + const SomeExpr &, const evaluate::DynamicType &); DataInitializations &inits_; evaluate::ExpressionAnalyzer &exprAnalyzer_; @@ -406,6 +409,32 @@ return folder.isEmpty(); } +std::optional> +DataInitializationCompiler::ConvertElement( + const SomeExpr &expr, const evaluate::DynamicType &type) { + if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) { + return {std::make_pair(std::move(*converted), false)}; + } + if (std::optional chValue{evaluate::GetScalarConstantValue< + evaluate::Type>(expr)}) { + // Allow DATA initialization with Hollerith and kind=1 CHARACTER like + // (most) other Fortran compilers do. Pad on the right with spaces + // when short, truncate the right if long. + // TODO: big-endian targets + std::size_t bytes{type.MeasureSizeInBytes().value()}; + evaluate::BOZLiteralConstant bits{0}; + for (std::size_t j{0}; j < bytes; ++j) { + char ch{j >= chValue->size() ? ' ' : chValue->at(j)}; + evaluate::BOZLiteralConstant chBOZ{static_cast(ch)}; + bits = bits.IOR(chBOZ.SHIFTL(8 * j)); + } + if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) { + return {std::make_pair(std::move(*converted), true)}; + } + } + return std::nullopt; +} + bool DataInitializationCompiler::InitElement( const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) { const Symbol &symbol{offsetSymbol.symbol()}; @@ -491,16 +520,19 @@ "Initializer for '%s' must not be a procedure"_err_en_US, DescribeElement()); } else if (auto designatorType{designator.GetType()}) { - if (auto converted{ - evaluate::ConvertToType(*designatorType, SomeExpr{*expr})}) { + if (auto converted{ConvertElement(*expr, *designatorType)}) { // value non-pointer initialization if (std::holds_alternative(expr->u) && designatorType->category() != TypeCategory::Integer) { // 8.6.7(11) exprAnalyzer_.Say(values_.LocateSource(), "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US, DescribeElement(), designatorType->AsFortran()); + } else if (converted->second) { + exprAnalyzer_.context().Say( + "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US, + DescribeElement(), designatorType->AsFortran()); } - auto folded{evaluate::Fold(context, std::move(*converted))}; + auto folded{evaluate::Fold(context, std::move(converted->first))}; switch ( GetImage().Add(offsetSymbol.offset(), offsetSymbol.size(), folded)) { case evaluate::InitialImage::Ok: diff --git a/flang/test/Semantics/data06.f90 b/flang/test/Semantics/data06.f90 --- a/flang/test/Semantics/data06.f90 +++ b/flang/test/Semantics/data06.f90 @@ -39,7 +39,7 @@ !ERROR: Initializer for 'rt' must not be a procedure data rt/rfunc/ integer :: jx, jy - !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx' + !WARNING: DATA statement value initializes 'jx' of type 'INTEGER(4)' with CHARACTER data jx/'abc'/ !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx' data jx/t1()/ diff --git a/flang/test/Semantics/data08.f90 b/flang/test/Semantics/data08.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/data08.f90 @@ -0,0 +1,17 @@ +! RUN: %f18 -fdebug-dump-symbols -fparse-only %s 2>&1 | FileCheck %s +! CHECK: DATA statement value initializes 'jx' of type 'INTEGER(4)' with CHARACTER +! CHECK: DATA statement value initializes 'jy' of type 'INTEGER(4)' with CHARACTER +! CHECK: DATA statement value initializes 'jz' of type 'INTEGER(4)' with CHARACTER +! CHECK: DATA statement value initializes 'kx' of type 'INTEGER(8)' with CHARACTER +! CHECK: jx (InDataStmt) size=4 offset=0: ObjectEntity type: INTEGER(4) init:1684234849_4 +! CHECK: jy (InDataStmt) size=4 offset=4: ObjectEntity type: INTEGER(4) init:543384161_4 +! CHECK: jz (InDataStmt) size=4 offset=8: ObjectEntity type: INTEGER(4) init:1684234849_4 +! CHECK: kx (InDataStmt) size=8 offset=16: ObjectEntity type: INTEGER(8) init:7523094288207667809_8 + +integer :: jx, jy, jz +integer(8) :: kx +data jx/4habcd/ +data jy/3habc/ +data jz/5habcde/ +data kx/'abcdefgh'/ +end