[flang] prevent rewrite of CMPLX with dynamically optional Y argument

[jeanPerier]

Summary

CMPLX was always rewritten as a complex constructor, but the second operand
of a complex constructor cannot be dynamically absent (i.e., a
disassociated pointer, an unallocated allocatable or an absent OPTIONAL
dummy argument), while the second argument of CMPLX can be dynamically
absent.

To avoid having to generate branches in complex constructor lowering
when Y is a pointer, keep the distinction between CMPLX and a complex
constructor when Y is a pointer, an allocatable, or an OPTIONAL entity.

flang/include/flang/Evaluate/tools.h

 }
 
 // Predicate: IsAllocatableOrPointer()
 template <typename A> bool IsAllocatableOrPointer(const A &x) {
   return GetAttrs(x).HasAny(
       semantics::Attrs{semantics::Attr::POINTER, semantics::Attr::ALLOCATABLE});
 }
 
+// Like IsAllocatableOrPointer, but accepts pointer function results as being
+// pointers.
+bool IsAllocatableOrPointerObject(const Expr<SomeType> &, FoldingContext &);
+
 // Procedure and pointer detection predicates
 bool IsProcedure(const Expr<SomeType> &);
 bool IsFunction(const Expr<SomeType> &);
 bool IsProcedurePointerTarget(const Expr<SomeType> &);
 bool IsBareNullPointer(const Expr<SomeType> *); // NULL() w/o MOLD=
 bool IsNullPointer(const Expr<SomeType> &);
 bool IsObjectPointer(const Expr<SomeType> &, FoldingContext &);
 
+// Can Expr be passed as absent to an optional dummy argument.
+// See 15.5.2.12 point 1 for more details.
+bool MayBePassedAsAbsentOptional(const Expr<SomeType> &, FoldingContext &);
+
 // Extracts the chain of symbols from a designator, which has perhaps been
 // wrapped in an Expr<>, removing all of the (co)subscripts.  The
 // base object will be the first symbol in the result vector.
 struct GetSymbolVectorHelper
     : public Traverse<GetSymbolVectorHelper, SymbolVector> {
   using Result = SymbolVector;
   using Base = Traverse<GetSymbolVectorHelper, Result>;
   using Base::operator();

flang/lib/Evaluate/fold-complex.cpp

if (name == "acos" || name == "acosh" || name == "asin" || name == "asinh" ||
     return FoldElementalIntrinsic<T, T>(
         context, std::move(funcRef), &Scalar<T>::CONJG);
   } else if (name == "cmplx") {
     if (args.size() > 0 && args[0].has_value()) {
       if (auto *x{UnwrapExpr<Expr<SomeComplex>>(args[0])}) {
         // CMPLX(X [, KIND]) with complex X
         return Fold(context, ConvertToType<T>(std::move(*x)));
       } else {
+        if (args.size() >= 2 && args[1].has_value()) {
+          // Do not fold CMPLX with an Y argument that may be absent at runtime
+          // into a complex constructor so that lowering can deal with the
+          // optional aspect (there is no optional aspect with the complex
+          // constructor).
+          if (MayBePassedAsAbsentOptional(*args[1]->UnwrapExpr(), context)) {
+            return Expr<T>{std::move(funcRef)};
+          }
+        }
         // CMPLX(X [, Y [, KIND]]) with non-complex X
         Expr<SomeType> re{std::move(*args[0].value().UnwrapExpr())};
         Expr<SomeType> im{args.size() >= 2 && args[1].has_value()
                 ? std::move(*args[1]->UnwrapExpr())
                 : AsGenericExpr(Constant<Part>{Scalar<Part>{}})};
         return Fold(context,
             Expr<T>{
                 ComplexConstructor<KIND>{ToReal<KIND>(context, std::move(re)),

flang/lib/Evaluate/tools.cpp

if (toType.category() == TypeCategory::Integer &&
         fromType->category() == TypeCategory::Logical) {
       return DataConstantConversionHelper<TypeCategory::Integer,
           TypeCategory::Logical>(context, toType, expr);
     }
   }
   return std::nullopt;
 }
 
+bool IsAllocatableOrPointerObject(
+    const Expr<SomeType> &expr, FoldingContext &context) {
+  const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
+  return (sym && semantics::IsAllocatableOrPointer(*sym)) ||
+      evaluate::IsObjectPointer(expr, context);
+}
+
+bool MayBePassedAsAbsentOptional(
+    const Expr<SomeType> &expr, FoldingContext &context) {
+  const semantics::Symbol *sym{UnwrapWholeSymbolOrComponentDataRef(expr)};
+  // 15.5.2.12 1. is pretty clear that an unallocated allocatable/pointer actual
+  // may be passed to a non-allocatable/non-pointer optional dummy. Note that
+  // other compilers (like nag, nvfortran, ifort, gfortran and xlf) seems to
+  // ignore this point in intrinsic contexts (e.g CMPLX argument).
+  return (sym && semantics::IsOptional(*sym)) ||
+      IsAllocatableOrPointerObject(expr, context);
+}
+
 } // namespace Fortran::evaluate
 
 namespace Fortran::semantics {
 
 const Symbol &ResolveAssociations(const Symbol &original) {
   const Symbol &symbol{original.GetUltimate()};
   if (const auto *details{symbol.detailsIf<AssocEntityDetails>()}) {
     if (const Symbol * nested{UnwrapWholeSymbolDataRef(details->expr())}) {