[flang-commits] [flang] ae93d8e - [flang] Fold TRANSFER()

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Wed Jul 13 15:35:02 PDT 2022


Author: Peter Klausler
Date: 2022-07-13T15:34:48-07:00
New Revision: ae93d8ea426d23cdbcc8e49ab729f635a52c872a

URL: https://github.com/llvm/llvm-project/commit/ae93d8ea426d23cdbcc8e49ab729f635a52c872a
DIFF: https://github.com/llvm/llvm-project/commit/ae93d8ea426d23cdbcc8e49ab729f635a52c872a.diff

LOG: [flang] Fold TRANSFER()

Fold usage of the raw data reinterpretation intrinsic function TRANSFER().

Differential Revision: https://reviews.llvm.org/D129671

Added: 
    flang/test/Evaluate/fold-transfer.f90

Modified: 
    flang/include/flang/Evaluate/constant.h
    flang/include/flang/Evaluate/initial-image.h
    flang/lib/Evaluate/fold-character.cpp
    flang/lib/Evaluate/fold-complex.cpp
    flang/lib/Evaluate/fold-implementation.h
    flang/lib/Evaluate/fold-integer.cpp
    flang/lib/Evaluate/fold-logical.cpp
    flang/lib/Evaluate/fold-real.cpp
    flang/lib/Evaluate/fold.cpp
    flang/lib/Evaluate/initial-image.cpp
    flang/lib/Semantics/data-to-inits.cpp
    flang/test/Evaluate/folding10.f90
    flang/test/Semantics/array-constr-values.f90
    flang/test/Semantics/case01.f90
    flang/test/Semantics/select-rank.f90
    flang/test/Semantics/structconst02.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index 6784adf9c4929..46c2f59f15537 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -189,9 +189,7 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
 
   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 90a781ba091fc..8e931bb3845bd 100644
--- a/flang/include/flang/Evaluate/initial-image.h
+++ b/flang/include/flang/Evaluate/initial-image.h
@@ -52,6 +52,7 @@ class InitialImage {
       } 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 @@ class InitialImage {
               (scalarBytes > elementBytes && elements != 0)) {
             return SizeMismatch;
           }
+          // TODO endianness
           std::memcpy(&data_.at(offset), scalar.data(), elementBytes);
           offset += elementBytes;
         }
@@ -103,7 +105,7 @@ class InitialImage {
 
   // 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 ed07b7ab62531..de058b69625d6 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 ab73b8f517ac3..3cd7c8490c582 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 6a04bfaf6834f..daa3f0a6512d7 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -70,6 +70,8 @@ template <typename T> class Folder {
   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 54b6582cffd81..eb8f0461ecb67 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 2b25f07bfc01e..b5b30b45630d2 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 0cc6b91230e75..159b2edf682ff 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 92ea4f130df6c..72257a3b89590 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 4ff4adb146c1f..0daffea66d87b 100644
--- a/flang/lib/Evaluate/initial-image.cpp
+++ b/flang/lib/Evaluate/initial-image.cpp
@@ -72,9 +72,9 @@ class AsConstantHelper {
   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 @@ class AsConstantHelper {
         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 @@ class AsConstantHelper {
             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 @@ class AsConstantHelper {
       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 @@ class AsConstantHelper {
       // 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 @@ class AsConstantHelper {
   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 be333d9d8c1d5..99f14dd2b4e85 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 0000000000000..ef5a52f83e0a1
--- /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 651caa1be5a31..937cf88b81b71 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 c814da2b6195f..2b5198f6dea78 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 147f8d89b1161..fcf91e85a7576 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 3e21e48605215..0dc915a99914a 100644
--- a/flang/test/Semantics/select-rank.f90
+++ b/flang/test/Semantics/select-rank.f90
@@ -239,7 +239,7 @@ subroutine CALL_ME_TYPES(x)
         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 1eb714253f903..24ec0a1964015 100644
--- a/flang/test/Semantics/structconst02.f90
+++ b/flang/test/Semantics/structconst02.f90
@@ -36,7 +36,7 @@ subroutine errors(n)
 !    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.))


        


More information about the flang-commits mailing list