Merge pull request #1096 from flang-compiler/jpr-cherry-pick-09-27-21

Cherry pick all flang commits from LLVM since last cherry-picking

Author: jeanPerier

flang/CMakeLists.txt

@@ -302,6 +302,14 @@ if (FLANG_REPOSITORY_STRING)
   add_definitions(-DFLANG_REPOSITORY_STRING="${FLANG_REPOSITORY_STRING}")
 endif()
 
+include(TestBigEndian)
+test_big_endian(IS_BIGENDIAN)
+if (IS_BIGENDIAN)
+  add_compile_definitions(FLANG_BIG_ENDIAN=1)
+else ()
+  add_compile_definitions(FLANG_LITTLE_ENDIAN=1)
+endif ()
+
 # Configure Flang's Version.inc file.
 configure_file(
   ${CMAKE_CURRENT_SOURCE_DIR}/include/flang/Version.inc.in

flang/docs/Intrinsics.md

@@ -746,7 +746,7 @@ This phase currently supports all the intrinsic procedures listed above but the
 
 | Intrinsic Category | Intrinsic Procedures Lacking Support |
 | --- | --- |
-| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, COSHAPE |
+| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, TEAM_NUMBER, COSHAPE |
 | Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
 | Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
 | Non-standard intrinsic functions | AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, LOC, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |

flang/include/flang/Evaluate/common.h

@@ -133,9 +133,9 @@ struct Rounding {
 
 static constexpr Rounding defaultRounding;
 
-#if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
+#if FLANG_BIG_ENDIAN
 constexpr bool isHostLittleEndian{false};
-#elif __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
+#elif FLANG_LITTLE_ENDIAN
 constexpr bool isHostLittleEndian{true};
 #else
 #error host endianness is not known

flang/include/flang/Evaluate/expression.h

@@ -118,8 +118,10 @@ class Operation {
 public:
   using Derived = DERIVED;
   using Result = RESULT;
-  static_assert(IsSpecificIntrinsicType<Result>);
   static constexpr std::size_t operands{sizeof...(OPERANDS)};
+  // Allow specific intrinsic types and Parentheses<SomeDerived>
+  static_assert(IsSpecificIntrinsicType<Result> ||
+      (operands == 1 && std::is_same_v<Result, SomeDerived>));
   template <int J> using Operand = std::tuple_element_t<J, OperandTypes>;
 
   // Unary operations wrap a single Expr with a CopyableIndirection.
@@ -174,7 +176,9 @@ class Operation {
     }
   }
 
-  static constexpr std::optional<DynamicType> GetType() {
+  static constexpr std::conditional_t<Result::category != TypeCategory::Derived,
+      std::optional<DynamicType>, void>
+  GetType() {
     return Result::GetType();
   }
   int Rank() const {
@@ -224,6 +228,17 @@ struct Parentheses : public Operation<Parentheses<A>, A, A> {
   using Base::Base;
 };
 
+template <>
+struct Parentheses<SomeDerived>
+    : public Operation<Parentheses<SomeDerived>, SomeDerived, SomeDerived> {
+public:
+  using Result = SomeDerived;
+  using Operand = SomeDerived;
+  using Base = Operation<Parentheses, SomeDerived, SomeDerived>;
+  using Base::Base;
+  DynamicType GetType() const;
+};
+
 template <typename A> struct Negate : public Operation<Negate<A>, A, A> {
   using Result = A;
   using Operand = A;
@@ -732,7 +747,7 @@ template <> class Expr<SomeDerived> : public ExpressionBase<SomeDerived> {
   using Result = SomeDerived;
   EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
   std::variant<Constant<Result>, ArrayConstructor<Result>, StructureConstructor,
-      Designator<Result>, FunctionRef<Result>>
+      Designator<Result>, FunctionRef<Result>, Parentheses<Result>>
       u;
 };
 
@@ -849,6 +864,8 @@ struct GenericExprWrapper {
 struct GenericAssignmentWrapper {
   GenericAssignmentWrapper() {}
   explicit GenericAssignmentWrapper(Assignment &&x) : v{std::move(x)} {}
+  explicit GenericAssignmentWrapper(std::optional<Assignment> &&x)
+      : v{std::move(x)} {}
   ~GenericAssignmentWrapper();
   static void Deleter(GenericAssignmentWrapper *);
   std::optional<Assignment> v; // vacant if error

flang/include/flang/Evaluate/real.h

@@ -219,21 +219,26 @@ class Real : public common::RealDetails<PREC> {
       return result;
     }
     ValueWithRealFlags<Real> intPart{ToWholeNumber(mode)};
-    int exponent{intPart.value.Exponent()};
-    result.flags.set(
-        RealFlag::Overflow, exponent >= exponentBias + result.value.bits);
     result.flags |= intPart.flags;
-    int shift{
-        exponent - exponentBias - binaryPrecision + 1}; // positive -> left
-    result.value =
-        result.value.ConvertUnsigned(intPart.value.GetFraction().SHIFTR(-shift))
-            .value.SHIFTL(shift);
+    int exponent{intPart.value.Exponent()};
+    // shift positive -> left shift, negative -> right shift
+    int shift{exponent - exponentBias - binaryPrecision + 1};
+    // Apply any right shift before moving to the result type
+    auto rshifted{intPart.value.GetFraction().SHIFTR(-shift)};
+    auto converted{result.value.ConvertUnsigned(rshifted)};
+    if (converted.overflow) {
+      result.flags.set(RealFlag::Overflow);
+    }
+    result.value = converted.value.SHIFTL(shift);
+    if (converted.value.CompareUnsigned(result.value.SHIFTR(shift)) !=
+        Ordering::Equal) {
+      result.flags.set(RealFlag::Overflow);
+    }
     if (IsSignBitSet()) {
-      auto negated{result.value.Negate()};
-      result.value = negated.value;
-      if (negated.overflow) {
-        result.flags.set(RealFlag::Overflow);
-      }
+      result.value = result.value.Negate().value;
+    }
+    if (IsSignBitSet() != result.value.IsNegative()) {
+      result.flags.set(RealFlag::Overflow);
     }
     if (result.flags.test(RealFlag::Overflow)) {
       result.value =

flang/include/flang/Evaluate/tools.h

@@ -89,6 +89,22 @@ template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
   return x && IsAssumedRank(*x);
 }
 
+// Predicate: true when an expression is a coarray (corank > 0)
+bool IsCoarray(const ActualArgument &);
+template <typename A> bool IsCoarray(const A &) { return false; }
+template <typename A> bool IsCoarray(const Designator<A> &designator) {
+  if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
+    return symbol->get().Corank() > 0;
+  }
+  return false;
+}
+template <typename T> bool IsCoarray(const Expr<T> &expr) {
+  return std::visit([](const auto &x) { return IsCoarray(x); }, expr.u);
+}
+template <typename A> bool IsCoarray(const std::optional<A> &x) {
+  return x && IsCoarray(*x);
+}
+
 // Generalizing packagers: these take operations and expressions of more
 // specific types and wrap them in Expr<> containers of more abstract types.
 
@@ -282,6 +298,9 @@ std::optional<DataRef> ExtractDataRef(const A *p, bool intoSubstring = false) {
     return std::nullopt;
   }
 }
+std::optional<DataRef> ExtractDataRef(
+    const ActualArgument &, bool intoSubstring = false);
+
 std::optional<DataRef> ExtractSubstringBase(const Substring &);
 
 // Predicate: is an expression is an array element reference?

flang/include/flang/Runtime/io-api.h

@@ -283,10 +283,10 @@ bool IONAME(SetFile)(Cookie, const char *, std::size_t chars);
 bool IONAME(GetNewUnit)(Cookie, int &, int kind = 4);
 
 // READ(SIZE=), after all input items
-bool IONAME(GetSize)(Cookie, std::int64_t, int kind = 8);
+std::size_t IONAME(GetSize)(Cookie);
 
 // INQUIRE(IOLENGTH=), after all output items
-bool IONAME(GetIoLength)(Cookie, std::int64_t, int kind = 8);
+std::size_t IONAME(GetIoLength)(Cookie);
 
 // GetIoMsg() does not modify its argument unless an error or
 // end-of-record/file condition is present.

flang/include/flang/Semantics/symbol.h

@@ -511,7 +511,7 @@ class Symbol {
       // OpenMP data-copying attribute
       OmpCopyIn, OmpCopyPrivate,
       // OpenMP miscellaneous flags
-      OmpCommonBlock, OmpReduction, OmpAligned, OmpAllocate,
+      OmpCommonBlock, OmpReduction, OmpAligned, OmpNontemporal, OmpAllocate,
       OmpDeclarativeAllocateDirective, OmpExecutableAllocateDirective,
       OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction,
       OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined);

flang/include/flang/Semantics/tools.h

@@ -179,10 +179,6 @@ inline bool IsAssumedSizeArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedSize();
 }
-inline bool IsAssumedRankArray(const Symbol &symbol) {
-  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
-  return details && details->IsAssumedRank();
-}
 bool IsAssumedLengthCharacter(const Symbol &);
 bool IsExternal(const Symbol &);
 bool IsModuleProcedure(const Symbol &);

flang/lib/Evaluate/CMakeLists.txt

@@ -34,6 +34,7 @@ add_flang_library(FortranEvaluate
   fold-integer.cpp
   fold-logical.cpp
   fold-real.cpp
+  fold-reduction.cpp
   formatting.cpp
   host.cpp
   initial-image.cpp