diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-07-05 16:32:59 -0700 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-07-13 15:34:48 -0700 |
commit | ae93d8ea426d23cdbcc8e49ab729f635a52c872a (patch) | |
tree | 26d672b5a398ff04010c19715e6bc4bde880aca1 | |
parent | 5acd471698849d9e322a29e6ca08791e8d447b7b (diff) | |
download | llvm-ae93d8ea426d23cdbcc8e49ab729f635a52c872a.zip llvm-ae93d8ea426d23cdbcc8e49ab729f635a52c872a.tar.gz llvm-ae93d8ea426d23cdbcc8e49ab729f635a52c872a.tar.bz2 |
[flang] Fold TRANSFER()
Fold usage of the raw data reinterpretation intrinsic function TRANSFER().
Differential Revision: https://reviews.llvm.org/D129671
-rw-r--r-- | flang/include/flang/Evaluate/constant.h | 4 | ||||
-rw-r--r-- | flang/include/flang/Evaluate/initial-image.h | 4 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-character.cpp | 1 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-complex.cpp | 2 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-implementation.h | 15 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-integer.cpp | 2 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-logical.cpp | 2 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-real.cpp | 2 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold.cpp | 53 | ||||
-rw-r--r-- | flang/lib/Evaluate/initial-image.cpp | 36 | ||||
-rw-r--r-- | flang/lib/Semantics/data-to-inits.cpp | 4 | ||||
-rw-r--r-- | flang/test/Evaluate/fold-transfer.f90 | 37 | ||||
-rw-r--r-- | flang/test/Evaluate/folding10.f90 | 12 | ||||
-rw-r--r-- | flang/test/Semantics/array-constr-values.f90 | 2 | ||||
-rw-r--r-- | flang/test/Semantics/case01.f90 | 12 | ||||
-rw-r--r-- | flang/test/Semantics/select-rank.f90 | 2 | ||||
-rw-r--r-- | flang/test/Semantics/structconst02.f90 | 2 |
17 files changed, 161 insertions, 31 deletions
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h index 6784adf..46c2f59 100644 --- a/flang/include/flang/Evaluate/constant.h +++ b/flang/include/flang/Evaluate/constant.h @@ -189,9 +189,7 @@ public: Constant Reshape(ConstantSubscripts &&) const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; - static constexpr DynamicType GetType() { - return {TypeCategory::Character, KIND}; - } + DynamicType GetType() const { return {KIND, length_}; } std::size_t CopyFrom(const Constant &source, std::size_t count, ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder); diff --git a/flang/include/flang/Evaluate/initial-image.h b/flang/include/flang/Evaluate/initial-image.h index 90a781b..8e931bb 100644 --- a/flang/include/flang/Evaluate/initial-image.h +++ b/flang/include/flang/Evaluate/initial-image.h @@ -52,6 +52,7 @@ public: } else if (bytes == 0) { return Ok; } else { + // TODO endianness std::memcpy(&data_.at(offset), &x.values().at(0), bytes); return Ok; } @@ -80,6 +81,7 @@ public: (scalarBytes > elementBytes && elements != 0)) { return SizeMismatch; } + // TODO endianness std::memcpy(&data_.at(offset), scalar.data(), elementBytes); offset += elementBytes; } @@ -103,7 +105,7 @@ public: // Conversions to constant initializers std::optional<Expr<SomeType>> AsConstant(FoldingContext &, - const DynamicType &, const ConstantSubscripts &, + const DynamicType &, const ConstantSubscripts &, bool padWithZero = false, ConstantSubscript offset = 0) const; std::optional<Expr<SomeType>> AsConstantPointer( ConstantSubscript offset = 0) const; diff --git a/flang/lib/Evaluate/fold-character.cpp b/flang/lib/Evaluate/fold-character.cpp index ed07b7a..de058b6 100644 --- a/flang/lib/Evaluate/fold-character.cpp +++ b/flang/lib/Evaluate/fold-character.cpp @@ -102,7 +102,6 @@ Expr<Type<TypeCategory::Character, KIND>> FoldIntrinsicFunction( CharacterUtils<KIND>::TRIM(std::get<Scalar<T>>(*scalar))}}; } } - // TODO: transfer return Expr<T>{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/fold-complex.cpp b/flang/lib/Evaluate/fold-complex.cpp index ab73b8f..3cd7c84 100644 --- a/flang/lib/Evaluate/fold-complex.cpp +++ b/flang/lib/Evaluate/fold-complex.cpp @@ -70,7 +70,7 @@ Expr<Type<TypeCategory::Complex, KIND>> FoldIntrinsicFunction( } else if (name == "sum") { return FoldSum<T>(context, std::move(funcRef)); } - // TODO: dot_product, matmul, transfer + // TODO: dot_product, matmul return Expr<T>{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h index 6a04bfa..daa3f0a 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -70,6 +70,8 @@ public: Expr<T> TRANSPOSE(FunctionRef<T> &&); Expr<T> UNPACK(FunctionRef<T> &&); + Expr<T> TRANSFER(FunctionRef<T> &&); + private: FoldingContext &context_; }; @@ -1013,6 +1015,17 @@ template <typename T> Expr<T> Folder<T>::UNPACK(FunctionRef<T> &&funcRef) { PackageConstant<T>(std::move(resultElements), *vector, mask->shape())}; } +std::optional<Expr<SomeType>> FoldTransfer( + FoldingContext &, const ActualArguments &); + +template <typename T> Expr<T> Folder<T>::TRANSFER(FunctionRef<T> &&funcRef) { + if (auto folded{FoldTransfer(context_, funcRef.arguments())}) { + return DEREF(UnwrapExpr<Expr<T>>(*folded)); + } else { + return Expr<T>{std::move(funcRef)}; + } +} + template <typename T> Expr<T> FoldMINorMAX( FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) { @@ -1119,6 +1132,8 @@ Expr<T> FoldOperation(FoldingContext &context, FunctionRef<T> &&funcRef) { return Folder<T>{context}.RESHAPE(std::move(funcRef)); } else if (name == "spread") { return Folder<T>{context}.SPREAD(std::move(funcRef)); + } else if (name == "transfer") { + return Folder<T>{context}.TRANSFER(std::move(funcRef)); } else if (name == "transpose") { return Folder<T>{context}.TRANSPOSE(std::move(funcRef)); } else if (name == "unpack") { diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index 54b6582..eb8f046 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -1053,7 +1053,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( } else if (name == "ubound") { return UBOUND(context, std::move(funcRef)); } - // TODO: dot_product, ishftc, matmul, sign, transfer + // TODO: dot_product, ishftc, matmul, sign return Expr<T>{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp index 2b25f07..b5b30b4 100644 --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -199,7 +199,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction( } // TODO: dot_product, is_iostat_end, // is_iostat_eor, logical, matmul, out_of_range, - // parity, transfer + // parity return Expr<T>{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/fold-real.cpp b/flang/lib/Evaluate/fold-real.cpp index 0cc6b91..159b2ed 100644 --- a/flang/lib/Evaluate/fold-real.cpp +++ b/flang/lib/Evaluate/fold-real.cpp @@ -315,7 +315,7 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction( return result.value; })); } - // TODO: dot_product, fraction, matmul, norm2, set_exponent, transfer + // TODO: dot_product, fraction, matmul, norm2, set_exponent return Expr<T>{std::move(funcRef)}; } diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp index 92ea4f1..72257a3 100644 --- a/flang/lib/Evaluate/fold.cpp +++ b/flang/lib/Evaluate/fold.cpp @@ -9,6 +9,7 @@ #include "flang/Evaluate/fold.h" #include "fold-implementation.h" #include "flang/Evaluate/characteristics.h" +#include "flang/Evaluate/initial-image.h" namespace Fortran::evaluate { @@ -220,6 +221,58 @@ Expr<ImpliedDoIndex::Result> FoldOperation( } } +// TRANSFER (F'2018 16.9.193) +std::optional<Expr<SomeType>> FoldTransfer( + FoldingContext &context, const ActualArguments &arguments) { + CHECK(arguments.size() == 2 || arguments.size() == 3); + const auto *source{UnwrapExpr<Expr<SomeType>>(arguments[0])}; + std::optional<std::size_t> sourceBytes; + if (source) { + if (auto sourceTypeAndShape{ + characteristics::TypeAndShape::Characterize(*source, context)}) { + if (auto sourceBytesExpr{ + sourceTypeAndShape->MeasureSizeInBytes(context)}) { + sourceBytes = ToInt64(*sourceBytesExpr); + } + } + } + std::optional<DynamicType> moldType; + if (arguments[1]) { + moldType = arguments[1]->GetType(); + } + std::optional<ConstantSubscripts> extents; + if (arguments.size() == 2) { // no SIZE= + if (moldType && sourceBytes) { + if (arguments[1]->Rank() == 0) { // scalar MOLD= + extents = ConstantSubscripts{}; // empty extents (scalar result) + } else if (auto moldBytesExpr{ + moldType->MeasureSizeInBytes(context, true)}) { + if (auto moldBytes{ToInt64(Fold(context, std::move(*moldBytesExpr)))}; + *moldBytes > 0) { + extents = ConstantSubscripts{ + static_cast<ConstantSubscript>((*sourceBytes) + *moldBytes - 1) / + *moldBytes}; + } + } + } + } else if (arguments[2]) { // SIZE= is present + if (const auto *sizeExpr{arguments[2]->UnwrapExpr()}) { + if (auto sizeValue{ToInt64(*sizeExpr)}) { + extents = ConstantSubscripts{*sizeValue}; + } + } + } + if (sourceBytes && IsActuallyConstant(*source) && moldType && extents) { + InitialImage image{*sourceBytes}; + InitialImage::Result imageResult{ + image.Add(0, *sourceBytes, *source, context)}; + CHECK(imageResult == InitialImage::Ok); + return image.AsConstant(context, *moldType, *extents, true /*pad with 0*/); + } else { + return std::nullopt; + } +} + template class ExpressionBase<SomeDerived>; template class ExpressionBase<SomeType>; diff --git a/flang/lib/Evaluate/initial-image.cpp b/flang/lib/Evaluate/initial-image.cpp index 4ff4adb..0daffea 100644 --- a/flang/lib/Evaluate/initial-image.cpp +++ b/flang/lib/Evaluate/initial-image.cpp @@ -72,9 +72,9 @@ public: using Types = AllTypes; AsConstantHelper(FoldingContext &context, const DynamicType &type, const ConstantSubscripts &extents, const InitialImage &image, - ConstantSubscript offset = 0) + bool padWithZero = false, ConstantSubscript offset = 0) : context_{context}, type_{type}, image_{image}, extents_{extents}, - offset_{offset} { + padWithZero_{padWithZero}, offset_{offset} { CHECK(!type.IsPolymorphic()); } template <typename T> Result Test() { @@ -94,7 +94,7 @@ public: ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))}; CHECK(elemBytes && *elemBytes >= 0); std::size_t stride{static_cast<std::size_t>(*elemBytes)}; - CHECK(offset_ + elements * stride <= image_.data_.size()); + CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_); if constexpr (T::category == TypeCategory::Derived) { const semantics::DerivedTypeSpec &derived{type_.GetDerivedTypeSpec()}; for (auto iter : DEREF(derived.scope())) { @@ -120,8 +120,8 @@ public: auto componentExtents{GetConstantExtents(context_, component)}; CHECK(componentExtents.has_value()); for (std::size_t j{0}; j < elements; ++j, at += stride) { - if (Result value{image_.AsConstant( - context_, *componentType, *componentExtents, at)}) { + if (Result value{image_.AsConstant(context_, *componentType, + *componentExtents, padWithZero_, at)}) { typedValue[j].emplace(component, std::move(*value)); } } @@ -134,8 +134,12 @@ public: auto length{static_cast<ConstantSubscript>(stride) / T::kind}; for (std::size_t j{0}; j < elements; ++j) { using Char = typename Scalar::value_type; - const Char *data{reinterpret_cast<const Char *>( - &image_.data_[offset_ + j * stride])}; + auto at{static_cast<std::size_t>(offset_ + j * stride)}; + if (at + length > image_.data_.size()) { + CHECK(padWithZero_); + break; + } + const Char *data{reinterpret_cast<const Char *>(&image_.data_[at])}; typedValue[j].assign(data, length); } return AsGenericExpr( @@ -144,8 +148,17 @@ public: // Lengthless intrinsic type CHECK(sizeof(Scalar) <= stride); for (std::size_t j{0}; j < elements; ++j) { - std::memcpy(&typedValue[j], &image_.data_[offset_ + j * stride], - sizeof(Scalar)); + auto at{static_cast<std::size_t>(offset_ + j * stride)}; + std::size_t chunk{sizeof(Scalar)}; + if (at + chunk > image_.data_.size()) { + CHECK(padWithZero_); + if (at >= image_.data_.size()) { + break; + } + chunk = image_.data_.size() - at; + } + // TODO endianness + std::memcpy(&typedValue[j], &image_.data_[at], chunk); } return AsGenericExpr(Const{std::move(typedValue), std::move(extents_)}); } @@ -156,14 +169,15 @@ private: const DynamicType &type_; const InitialImage &image_; ConstantSubscripts extents_; // a copy + bool padWithZero_; ConstantSubscript offset_; }; std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context, const DynamicType &type, const ConstantSubscripts &extents, - ConstantSubscript offset) const { + bool padWithZero, ConstantSubscript offset) const { return common::SearchTypes( - AsConstantHelper{context, type, extents, *this, offset}); + AsConstantHelper{context, type, extents, *this, padWithZero, offset}); } std::optional<Expr<SomeType>> InitialImage::AsConstantPointer( diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp index be333d9..99f14dd 100644 --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -541,8 +541,8 @@ static void PopulateWithComponentDefaults(SymbolDataInitialization &init, if (auto dyType{evaluate::DynamicType::From(component)}) { if (auto extents{evaluate::GetConstantExtents( foldingContext, component)}) { - if (auto extant{init.image.AsConstant( - foldingContext, *dyType, *extents, componentOffset)}) { + if (auto extant{init.image.AsConstant(foldingContext, *dyType, + *extents, false /*don't pad*/, componentOffset)}) { initialized = !(*extant == *object->init()); } } diff --git a/flang/test/Evaluate/fold-transfer.f90 b/flang/test/Evaluate/fold-transfer.f90 new file mode 100644 index 0000000..ef5a52f --- /dev/null +++ b/flang/test/Evaluate/fold-transfer.f90 @@ -0,0 +1,37 @@ +! RUN: %python %S/test_folding.py %s %flang_fc1 +! Tests folding of TRANSFER(...) + +module m + logical, parameter :: test_r2i_s_1 = transfer(1., 0) == int(z'3f800000') + logical, parameter :: test_r2i_v_1 = all(transfer(1., [integer::]) == [int(z'3f800000')]) + logical, parameter :: test_r2i_v_2 = all(transfer([1., 2.], [integer::]) == [int(z'3f800000'), int(z'40000000')]) + logical, parameter :: test_r2i_vs_1 = all(transfer([1., 2.], [integer::], 1) == [int(z'3f800000')]) + + type :: t + real :: x = 0. + end type t + logical, parameter :: test_t2i_s_1 = transfer(t(1.), 0) == int(z'3f800000') + logical, parameter :: test_t2i_v_1 = all(transfer(t(1.), [integer::]) == [int(z'3f800000')]) + logical, parameter :: test_t2i_v_2 = all(transfer([t(1.), t(2.)], [integer::]) == [int(z'3f800000'), int(z'40000000')]) + logical, parameter :: test_t2i_vs_1 = all(transfer([t(1.), t(2.)], [integer::], 1) == [int(z'3f800000')]) + + type(t), parameter :: t1 = transfer(1., t()) + logical, parameter :: test_r2t_s_1 = t1%x == 1. + type(t), parameter :: t2(*) = transfer(1., [t::]) + logical, parameter :: test_r2t_v_1 = all(t2%x == [1.]) + type(t), parameter :: t3(*) = transfer([1., 2.], [t::]) + logical, parameter :: test_r2t_v_2 = all(t3%x == [1., 2.]) + type(t), parameter :: t4(*) = transfer([1., 2.], t(), 1) + logical, parameter :: test_r2t_vs_1 = all(t4%x == [1.]) + + logical, parameter :: test_nan = transfer(int(z'7ff8000000000000', 8), 0._8) /= transfer(int(z'7ff8000000000000', 8), 0._8) + + integer, parameter :: jc1 = transfer("abcd", 0) + logical, parameter :: test_c2i_s_1 = jc1 == int(z'61626364') .or. jc1 == int(z'64636261') + integer, parameter :: jc2(*) = transfer("abcd", [integer::]) + logical, parameter :: test_c2i_v_1 = all(jc2 == int(z'61626364') .or. jc1 == int(z'64636261')) + integer, parameter :: jc3(*) = transfer(["abcd", "efgh"], [integer::]) + logical, parameter :: test_c2i_v_2 = all(jc3 == [int(z'61626364'), int(z'65666768')]) .or. all(jc3 == [int(z'64636261'), int(z'68676665')]) + integer, parameter :: jc4(*) = transfer(["abcd", "efgh"], 0, 1) + logical, parameter :: test_c2i_vs_1 = all(jc4 == [int(z'61626364')]) .or. all(jc4 == [int(z'64636261')]) +end module diff --git a/flang/test/Evaluate/folding10.f90 b/flang/test/Evaluate/folding10.f90 index 651caa1..937cf88b 100644 --- a/flang/test/Evaluate/folding10.f90 +++ b/flang/test/Evaluate/folding10.f90 @@ -1,7 +1,19 @@ ! RUN: %python %S/test_folding.py %s %flang_fc1 ! Tests folding of SHAPE(TRANSFER(...)) +! Adjusted to allow for folding (or not) of TRANSFER(). module m + integer :: j + real :: a(3) + logical, parameter :: test_size_v1 = size(shape(transfer(j, 0_1,size=4))) == 1 + logical, parameter :: test_size_v2 = all(shape(transfer(j, 0_1,size=4)) == [4]) + logical, parameter :: test_scalar_v1 = size(shape(transfer(j, 0_1))) == 0 + logical, parameter :: test_vector_v1 = size(shape(transfer(j, [0_1]))) == 1 + logical, parameter :: test_vector_v2 = all(shape(transfer(j, [0_1])) == [4]) + logical, parameter :: test_array_v1 = size(shape(transfer(j, reshape([0_1],[1,1])))) == 1 + logical, parameter :: test_array_v2 = all(shape(transfer(j, reshape([0_1],[1,1]))) == [4]) + logical, parameter :: test_array_v3 = all(shape(transfer(a, [(0.,0.)])) == [2]) + logical, parameter :: test_size_1 = size(shape(transfer(123456789,0_1,size=4))) == 1 logical, parameter :: test_size_2 = all(shape(transfer(123456789,0_1,size=4)) == [4]) logical, parameter :: test_scalar_1 = size(shape(transfer(123456789, 0_1))) == 0 diff --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90 index c814da2..2b5198f 100644 --- a/flang/test/Semantics/array-constr-values.f90 +++ b/flang/test/Semantics/array-constr-values.f90 @@ -29,7 +29,7 @@ subroutine arrayconstructorvalues() ! C7111 !ERROR: Value in array constructor of type 'LOGICAL(4)' could not be converted to the type of the array 'INTEGER(4)' intarray = [integer:: .true., 2, 3, 4, 5] - !ERROR: Value in array constructor of type 'CHARACTER(1)' could not be converted to the type of the array 'INTEGER(4)' + !ERROR: Value in array constructor of type 'CHARACTER(KIND=1,LEN=22_8)' could not be converted to the type of the array 'INTEGER(4)' intarray = [integer:: "RAM stores information", 2, 3, 4, 5] !ERROR: Value in array constructor of type 'employee' could not be converted to the type of the array 'INTEGER(4)' intarray = [integer:: EMPLOYEE (19, "Jack"), 2, 3, 4, 5] diff --git a/flang/test/Semantics/case01.f90 b/flang/test/Semantics/case01.f90 index 147f8d8..fcf91e8 100644 --- a/flang/test/Semantics/case01.f90 +++ b/flang/test/Semantics/case01.f90 @@ -69,7 +69,7 @@ program selectCaseProg ! C1147 select case (grade2) - !ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' + !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' case (:'Z') case default end select @@ -94,19 +94,19 @@ program selectCaseProg case (.true. :) !ERROR: CASE value has type 'REAL(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' case (1.0) - !ERROR: CASE value has type 'CHARACTER(1)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' + !ERROR: CASE value has type 'CHARACTER(KIND=1,LEN=3_8)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)' case ('wow') end select select case (ASCII_parm1) case (ASCII_parm2) - !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)' + !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' case (UCS32_parm) - !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)' + !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=1_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' case (UCS16_parm) - !ERROR: CASE value has type 'CHARACTER(4)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)' + !ERROR: CASE value has type 'CHARACTER(KIND=4,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' case (4_"ucs-32") - !ERROR: CASE value has type 'CHARACTER(2)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(1)' + !ERROR: CASE value has type 'CHARACTER(KIND=2,LEN=6_8)' which is not compatible with the SELECT CASE expression's type 'CHARACTER(KIND=1,LEN=1_8)' case (2_"ucs-16") case default end select diff --git a/flang/test/Semantics/select-rank.f90 b/flang/test/Semantics/select-rank.f90 index 3e21e48..0dc915a 100644 --- a/flang/test/Semantics/select-rank.f90 +++ b/flang/test/Semantics/select-rank.f90 @@ -239,7 +239,7 @@ contains RANK(1.0) !ERROR: Must be a constant value RANK(RANK(x)) - !ERROR: Must have INTEGER type, but is CHARACTER(1) + !ERROR: Must have INTEGER type, but is CHARACTER(KIND=1,LEN=6_8) RANK("STRING") END SELECT end subroutine diff --git a/flang/test/Semantics/structconst02.f90 b/flang/test/Semantics/structconst02.f90 index 1eb7142..24ec0a1 100644 --- a/flang/test/Semantics/structconst02.f90 +++ b/flang/test/Semantics/structconst02.f90 @@ -36,7 +36,7 @@ module module1 ! call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true._4)) call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true.)) call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true.)) - !ERROR: Value in structure constructor of type 'CHARACTER(1)' is incompatible with component 'ix' of type 'INTEGER(4)' + !ERROR: Value in structure constructor of type 'CHARACTER(KIND=1,LEN=1_8)' is incompatible with component 'ix' of type 'INTEGER(4)' call scalararg(scalar(4)(ix='a')) !ERROR: Value in structure constructor of type 'LOGICAL(4)' is incompatible with component 'ix' of type 'INTEGER(4)' call scalararg(scalar(4)(ix=.false.)) |