From 00c3c274de3b4f954ff727676354cba5ba6a197d Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Thu, 5 Dec 2019 16:18:39 -0800
Subject: [PATCH] [flang] Allow assignment between INTEGER and LOGICAL as
 extension

Extend documentation

Original-commit: flang-compiler/f18@7a719198fc7dc09f50cd1e4129d87f2ace711c4b
Reviewed-on: https://github.com/flang-compiler/f18/pull/856
---
 flang/documentation/Extensions.md   |  4 +++-
 flang/lib/common/Fortran-features.h |  2 +-
 flang/lib/semantics/expression.cc   | 34 +++++++++++++++++++++++++++++++---
 3 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md
index 12444af..1fe4d46 100644
--- a/flang/documentation/Extensions.md
+++ b/flang/documentation/Extensions.md
@@ -109,6 +109,8 @@ Extensions, deletions, and legacy features supported by default
 * When a dummy argument is `POINTER` or `ALLOCATABLE` and is `INTENT(IN)`, we
   relax enforcement of some requirements on actual arguments that must otherwise
   hold true for definable arguments.
+* Assignment of `LOGICAL` to `INTEGER` and vice versa (but not other types).
+  The values are normalized.
 
 Extensions supported when enabled by options
 --------------------------------------------
@@ -140,7 +142,7 @@ Extensions and legacy features deliberately not supported
 * Defining an explicit interface for a subprogram within itself (PGI only)
 * USE association of a procedure interface within that same procedure's definition
 * NULL() as a structure constructor expression for an ALLOCATABLE component (PGI).
-* Conversion of LOGICAL to INTEGER.
+* Conversion of LOGICAL to INTEGER in expressions.
 * IF (integer expression) THEN ... END IF  (PGI/Intel)
 * Comparsion of LOGICAL with ==/.EQ. rather than .EQV. (also .NEQV.) (PGI/Intel)
 * Procedure pointers in COMMON blocks (PGI/Intel)
diff --git a/flang/lib/common/Fortran-features.h b/flang/lib/common/Fortran-features.h
index 066df78..c9b3f13 100644
--- a/flang/lib/common/Fortran-features.h
+++ b/flang/lib/common/Fortran-features.h
@@ -33,7 +33,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     Hollerith, ArithmeticIF, Assign, AssignedGOTO, Pause, OpenMP,
     CruftAfterAmpersand, ClassicCComments, AdditionalFormats, BigIntLiterals,
     RealDoControls, EquivalenceNumericWithCharacter, AdditionalIntrinsics,
-    AnonymousParents, OldLabelDoEndStatements)
+    AnonymousParents, OldLabelDoEndStatements, LogicalIntegerAssignment)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index 457557d..8fbbf9b 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -2578,8 +2578,12 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
   using semantics::Tristate;
   const Expr<SomeType> &lhs{GetExpr(0)};
   const Expr<SomeType> &rhs{GetExpr(1)};
-  Tristate isDefined{semantics::IsDefinedAssignment(
-      lhs.GetType(), lhs.Rank(), rhs.GetType(), rhs.Rank())};
+  std::optional<DynamicType> lhsType{lhs.GetType()};
+  std::optional<DynamicType> rhsType{rhs.GetType()};
+  int lhsRank{lhs.Rank()};
+  int rhsRank{rhs.Rank()};
+  Tristate isDefined{
+      semantics::IsDefinedAssignment(lhsType, lhsRank, rhsType, rhsRank)};
   if (isDefined == Tristate::No) {
     return std::nullopt;  // user-defined assignment not allowed for these args
   }
@@ -2587,7 +2591,31 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
   auto procRef{GetDefinedAssignmentProc()};
   if (!procRef) {
     if (isDefined == Tristate::Yes) {
-      SayNoMatch("ASSIGNMENT(=)", true);
+      if (context_.context().languageFeatures().IsEnabled(
+              common::LanguageFeature::LogicalIntegerAssignment) &&
+          lhsType && rhsType && (lhsRank == rhsRank || rhsRank == 0)) {
+        if (lhsType->category() == TypeCategory::Integer &&
+            rhsType->category() == TypeCategory::Logical) {
+          // allow assignment to LOGICAL from INTEGER as a legacy extension
+          if (context_.context().languageFeatures().ShouldWarn(
+                  common::LanguageFeature::LogicalIntegerAssignment)) {
+            context_.Say(
+                "nonstandard usage: assignment of LOGICAL to INTEGER"_en_US);
+          }
+        } else if (lhsType->category() == TypeCategory::Logical &&
+            rhsType->category() == TypeCategory::Integer) {
+          // ... and assignment to LOGICAL from INTEGER
+          if (context_.context().languageFeatures().ShouldWarn(
+                  common::LanguageFeature::LogicalIntegerAssignment)) {
+            context_.Say(
+                "nonstandard usage: assignment of INTEGER to LOGICAL"_en_US);
+          }
+        } else {
+          SayNoMatch("ASSIGNMENT(=)", true);
+        }
+      } else {
+        SayNoMatch("ASSIGNMENT(=)", true);
+      }
     }
     return std::nullopt;
   }
-- 
2.7.4