diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md index 12444af012b9a..1fe4d46c8c257 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 066df78f86a6d..c9b3f13c11587 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; diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 457557db8ace1..8fbbf9b09e118 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -2578,8 +2578,12 @@ std::optional ArgumentAnalyzer::TryDefinedAssignment() { using semantics::Tristate; const Expr &lhs{GetExpr(0)}; const Expr &rhs{GetExpr(1)}; - Tristate isDefined{semantics::IsDefinedAssignment( - lhs.GetType(), lhs.Rank(), rhs.GetType(), rhs.Rank())}; + std::optional lhsType{lhs.GetType()}; + std::optional 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 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; }