[flang] Fix LEN(char array), it is not elemental.

Original-commit: flang-compiler/f18@b44eb2e7b1fd8d86e95d3c24014e542bdb39877d
Reviewed-on: https://github.com/flang-compiler/f18/pull/477
Tree-same-pre-rewrite: false

diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc
index 81dc5a5c49768f2dc4e9a1a1acffa106f69d81cb..06ac427df3f3b50da332b64f1f7720a93121a295 100644 (file)
--- a/flang/lib/evaluate/intrinsics.cc
+++ b/flang/lib/evaluate/intrinsics.cc
@@ -410,7 +410,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
         {{"array", Anything, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
         KINDInt, Rank::vector},
     {"leadz", {{"i", AnyInt}}, DefaultInt},
-    {"len", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt},
+    {"len", {{"string", AnyChar, Rank::anyOrAssumedRank}, SubscriptDefaultKIND},
+        KINDInt},
     {"len_trim", {{"string", AnyChar}, SubscriptDefaultKIND}, KINDInt},
     {"lge", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
     {"lgt", {{"string_a", SameChar}, {"string_b", SameChar}}, DefaultLogical},
@@ -733,7 +734,7 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"index", {{"string", DefaultChar}, {"substring", DefaultChar}},
         DefaultInt}},
     {{"isign", {{"a", DefaultInt}, {"b", DefaultInt}}, DefaultInt}, "sign"},
-    {{"len", {{"string", DefaultChar}}, DefaultInt}},
+    {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt}},
     {{"log", {{"x", DefaultReal}}, DefaultReal}},
     {{"log10", {{"x", DefaultReal}}, DefaultReal}},
     {{"max0",

diff --git a/flang/lib/evaluate/logical.h b/flang/lib/evaluate/logical.h
index e0007c58bf5bee373e2c7c0a04aa7511a65990ce..c6eacd82177ecfae81c478d46aab7287367a121d 100644 (file)
--- a/flang/lib/evaluate/logical.h
+++ b/flang/lib/evaluate/logical.h
@@ -1,4 +1,4 @@
-// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+// Copyright (c) 2018-2019, NVIDIA CORPORATION.  All rights reserved.
 //
 // Licensed under the Apache License, Version 2.0 (the "License");
 // you may not use this file except in compliance with the License.
@@ -20,12 +20,18 @@
 
 namespace Fortran::evaluate::value {
 
-template<int BITS> class Logical {
+template<int BITS, bool IS_LIKE_C = false> class Logical {
 public:
   static constexpr int bits{BITS};
+
+  // Module ISO_C_BINDING kind C_BOOL is LOGICAL(KIND=1) and must have
+  // C's bit representation (.TRUE. -> 1, .FALSE. -> 0).
+  static constexpr bool IsLikeC{BITS <= 8 || IS_LIKE_C};
+
   constexpr Logical() {}  // .FALSE.
   constexpr Logical(const Logical &that) = default;
-  constexpr Logical(bool truth) : word_{-std::uint64_t{truth}} {}
+  constexpr Logical(bool truth)
+    : word_{truth ? canonicalTrue : canonicalFalse} {}
   constexpr Logical &operator=(const Logical &) = default;
 
   template<int B> constexpr bool operator==(const Logical<B> &that) const {
@@ -33,9 +39,15 @@ public:
   }
 
   // For static expression evaluation, all the bits will have the same value.
-  constexpr bool IsTrue() const { return word_.BTEST(0); }
+  constexpr bool IsTrue() const {
+    if constexpr (IsLikeC) {
+      return !word_.IsZero();
+    } else {
+      return word_.BTEST(0);
+    }
+  }
 
-  constexpr Logical NOT() const { return {word_.NOT()}; }
+  constexpr Logical NOT() const { return {word_.IEOR(canonicalTrue)}; }
 
   constexpr Logical AND(const Logical &that) const {
     return {word_.IAND(that.word_)};
@@ -53,6 +65,8 @@ public:
 
 private:
   using Word = Integer<bits>;
+  static constexpr Word canonicalTrue{IsLikeC ? -std::uint64_t{1} : 1};
+  static constexpr Word canonicalFalse{0};
   constexpr Logical(const Word &w) : word_{w} {}
   Word word_;
 };