[flang] Adjust "doubled operator" expression extension

flang/docs/Extensions.md

@@ -356,6 +356,8 @@ end
 * A derived type that meets (most of) the requirements of an interoperable
   derived type can be used as such where an interoperable type is
   required, with warnings, even if it lacks the BIND(C) attribute.
+* A "mult-operand" in an expression can be preceded by a unary
+  `+` or `-` operator.
 
 ### Extensions supported when enabled by options
 

flang/include/flang/Common/Fortran-features.h

@@ -24,7 +24,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     DoubleComplex, Byte, StarKind, ExponentMatchingKindParam, QuadPrecision,
     SlashInitialization, TripletInArrayConstructor, MissingColons,
     SignedComplexLiteral, OldStyleParameter, ComplexConstructor, PercentLOC,
-    SignedPrimary, FileName, Carriagecontrol, Convert, Dispose,
+    SignedMultOperand, FileName, Carriagecontrol, Convert, Dispose,
     IOListLeadingComma, AbbreviatedEditDescriptor, ProgramParentheses,
     PercentRefAndVal, OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF,
     Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CUDA, CruftAfterAmpersand,

flang/lib/Parser/expr-parsers.cpp

@@ -87,14 +87,8 @@ constexpr auto primary{instrumented("primary"_en_US,
 // R1002 level-1-expr -> [defined-unary-op] primary
 // TODO: Reasonable extension: permit multiple defined-unary-ops
 constexpr auto level1Expr{sourced(
-    first(primary, // must come before define op to resolve .TRUE._8 ambiguity
-        construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)),
-        extension<LanguageFeature::SignedPrimary>(
-            "nonstandard usage: signed primary"_port_en_US,
-            construct<Expr>(construct<Expr::UnaryPlus>("+" >> primary))),
-        extension<LanguageFeature::SignedPrimary>(
-            "nonstandard usage: signed primary"_port_en_US,
-            construct<Expr>(construct<Expr::Negate>("-" >> primary)))))};
+    primary || // must come before define op to resolve .TRUE._8 ambiguity
+    construct<Expr>(construct<Expr::DefinedUnary>(definedOpName, primary)))};
 
 // R1004 mult-operand -> level-1-expr [power-op mult-operand]
 // R1007 power-op -> **
@@ -105,7 +99,19 @@ struct MultOperand {
   static inline std::optional<Expr> Parse(ParseState &);
 };
 
-static constexpr auto multOperand{sourced(MultOperand{})};
+// Extension: allow + or - before a mult-operand
+// Such a unary operand has lower precedence than exponentiation,
+// so -x**2 is -(x**2), not (-x)**2; this matches all other
+// compilers with this extension.
+static constexpr auto standardMultOperand{sourced(MultOperand{})};
+static constexpr auto multOperand{standardMultOperand ||
+    extension<LanguageFeature::SignedMultOperand>(
+        "nonstandard usage: signed mult-operand"_port_en_US,
+        construct<Expr>(
+            construct<Expr::UnaryPlus>("+" >> standardMultOperand))) ||
+    extension<LanguageFeature::SignedMultOperand>(
+        "nonstandard usage: signed mult-operand"_port_en_US,
+        construct<Expr>(construct<Expr::Negate>("-" >> standardMultOperand)))};
 
 inline std::optional<Expr> MultOperand::Parse(ParseState &state) {
   std::optional<Expr> result{level1Expr.Parse(state)};

flang/test/Evaluate/signed-mult-opd.f90

@@ -0,0 +1,12 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1
+module m
+  integer, parameter :: j = 2
+  ! standard cases
+  logical, parameter :: test_1 = -j**2 == -4
+  logical, parameter :: test_2 = 4-j**2 == 0
+  ! extension cases
+  logical, parameter :: test_3 = 4+-j**2 == 0 ! not 8
+  logical, parameter :: test_4 = 2*-j**2 == -8 ! not 8
+  logical, parameter :: test_5 = -j**2+-j**2 == -8 ! not 8
+  logical, parameter :: test_6 = j**2*-j**2 == -16 ! not 16
+end