[flang] Change error to portability warning

[klausler]

Summary

The standard does *not* require that a real or imaginary part of a complex
literal constant be a scalar if it is a named constant. Downgrade a
recently installed check to a portability warning, and document it.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/docs/Extensions.md

* f18 supports designators with constant expressions, properly
   it yet.
 * According to 11.1.3.3p1, if a selector of an `ASSOCIATE` or
   related construct is defined by a variable, it has the `TARGET`
   attribute if the variable was a `POINTER` or `TARGET`.
   We read this to include the case of the variable being a
   pointer-valued function reference.
   No other Fortran compiler seems to handle this correctly for
   `ASSOCIATE`, though NAG gets it right for `SELECT TYPE`.
+* The standard doesn't explicitly require that a named constant that
+  appears as part of a complex-literal-constant be a scalar, but
+  most compilers emit an error when an array appears.
+  f18 supports them with a portability warning.
 
 ## Behavior in cases where the standard is ambiguous or indefinite
 
 * When an inner procedure of a subprogram uses the value or an attribute
   of an undeclared name in a specification expression and that name does
   not appear in the host, it is not clear in the standard whether that
   name is an implicitly typed local variable of the inner procedure or a
   host association with an implicitly typed local variable of the host.

flang/include/flang/Semantics/expression.h

bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
       bool defaultKind = false);
   MaybeExpr MakeFunctionRef(
       parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
   MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
   template <typename T> T Fold(T &&expr) {
     return evaluate::Fold(foldingContext_, std::move(expr));
   }
   bool CheckIsValidForwardReference(const semantics::DerivedTypeSpec &);
+  MaybeExpr AnalyzeComplex(MaybeExpr &&re, MaybeExpr &&im, const char *what);
 
   semantics::SemanticsContext &context_;
   FoldingContext &foldingContext_{context_.foldingContext()};
   std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
   bool isWholeAssumedSizeArrayOk_{false};
   bool useSavedTypedExprs_{true};
   bool inWhereBody_{false};
   bool inDataStmtConstant_{false};

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::Analyze(
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexPart &x) {
   return Analyze(x.u);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ComplexLiteralConstant &z) {
-  return AsMaybeExpr(
-      ConstructComplex(GetContextualMessages(), Analyze(std::get<0>(z.t)),
-          Analyze(std::get<1>(z.t)), GetDefaultKind(TypeCategory::Real)));
+  return AnalyzeComplex(Analyze(std::get<0>(z.t)), Analyze(std::get<1>(z.t)),
+      "complex literal constant");
 }
 
 // CHARACTER literal processing.
 MaybeExpr ExpressionAnalyzer::AnalyzeString(std::string &&string, int kind) {
   if (!CheckIntrinsicKind(TypeCategory::Character, kind)) {
     return std::nullopt;
   }
   switch (kind) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Add &x) {
   return NumericBinaryHelper<Add>(*this, NumericOperator::Add, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
   return NumericBinaryHelper<Subtract>(*this, NumericOperator::Subtract, x);
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(
-    const parser::Expr::ComplexConstructor &x) {
-  auto re{Analyze(std::get<0>(x.t).value())};
-  auto im{Analyze(std::get<1>(x.t).value())};
-  if (re && re->Rank() > 0) {
-    context().Say(std::get<0>(x.t).value().source,
-        "Real part of complex constructor must be scalar"_err_en_US);
-  }
-  if (im && im->Rank() > 0) {
-    context().Say(std::get<1>(x.t).value().source,
-        "Imaginary part of complex constructor must be scalar"_err_en_US);
-  }
-  if (re && im) {
-    ConformabilityCheck(GetContextualMessages(), *re, *im);
-  }
-  return AsMaybeExpr(ConstructComplex(GetContextualMessages(), std::move(re),
-      std::move(im), GetDefaultKind(TypeCategory::Real)));
+    const parser::Expr::ComplexConstructor &z) {
+  return AnalyzeComplex(Analyze(std::get<0>(z.t).value()),
+      Analyze(std::get<1>(z.t).value()), "complex constructor");
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
   ArgumentAnalyzer analyzer{*this};
   analyzer.Analyze(std::get<0>(x.t));
   analyzer.Analyze(std::get<1>(x.t));
   if (!analyzer.fatalErrors()) {
     if (analyzer.IsIntrinsicConcat()) {
if (std::optional<SpecificCall> specificCall{
     return MakeFunctionRef(intrinsic,
         ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
         std::move(specificCall->arguments));
   } else {
     return std::nullopt;
   }
 }
 
+MaybeExpr ExpressionAnalyzer::AnalyzeComplex(
+    MaybeExpr &&re, MaybeExpr &&im, const char *what) {
+  if (re && re->Rank() > 0) {
+    Say("Real part of %s is not scalar"_port_en_US, what);
+  }
+  if (im && im->Rank() > 0) {
+    Say("Imaginary part of %s is not scalar"_port_en_US, what);
+  }
+  if (re && im) {
+    ConformabilityCheck(GetContextualMessages(), *re, *im);
+  }
+  return AsMaybeExpr(ConstructComplex(GetContextualMessages(), std::move(re),
+      std::move(im), GetDefaultKind(TypeCategory::Real)));
+}
+
 void ArgumentAnalyzer::Analyze(const parser::Variable &x) {
   source_.ExtendToCover(x.GetSource());
   if (MaybeExpr expr{context_.Analyze(x)}) {
     if (!IsConstantExpr(*expr)) {
       actuals_.emplace_back(std::move(*expr));
       SetArgSourceLocation(actuals_.back(), x.GetSource());
       return;
     }

flang/test/Semantics/expr-errors05.f90

-! RUN: %python %S/test_errors.py %s %flang_fc1
-! The components of a complex constructor (extension) must be scalar
-!ERROR: Real part of complex constructor must be scalar
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+!PORTABILITY: Real part of complex constructor is not scalar
 complex, parameter :: z1(*) = ([1.,2.], 3.)
-!ERROR: Imaginary part of complex constructor must be scalar
+!PORTABILITY: Imaginary part of complex constructor is not scalar
 complex, parameter :: z2(*) = (4., [5.,6.])
+real, parameter :: aa(*) = [7.,8.]
+!PORTABILITY: Real part of complex literal constant is not scalar
+complex, parameter :: z3(*) = (aa, 9.)
+!PORTABILITY: Imaginary part of complex literal constant is not scalar
+complex, parameter :: z4(*) = (10., aa)
+!We need a nonzero exit status to make test_errors.py look at messages :-(
+!WARNING: division by zero
+real, parameter :: xxx = 1./0.
 end