diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -350,6 +350,10 @@ 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 diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -369,6 +369,7 @@ 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()}; diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -698,9 +698,8 @@ } 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. @@ -2861,22 +2860,9 @@ } 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) { @@ -3391,6 +3377,21 @@ } } +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)}) { diff --git a/flang/test/Semantics/expr-errors05.f90 b/flang/test/Semantics/expr-errors05.f90 --- a/flang/test/Semantics/expr-errors05.f90 +++ b/flang/test/Semantics/expr-errors05.f90 @@ -1,7 +1,14 @@ -! 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