[flang] Allow pure function references in expandable scalar

[klausler]

Summary

F18 disallows function references and coarray references from
appearing in scalar expressions that are to be expanded into
arrays to conform with other operands or actual arguments in
an elemental expression. This is too strong, as pure procedures
can be safely used.

[jeanPerier]

LGTM

flang/include/flang/Evaluate/call.h

struct ProcedureDesignator {
   const Component *GetComponent() const;
 
   const Symbol *GetInterfaceSymbol() const;
 
   std::string GetName() const;
   std::optional<DynamicType> GetType() const;
   int Rank() const;
   bool IsElemental() const;
+  bool IsPure() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
   std::variant<SpecificIntrinsic, SymbolRef,
       common::CopyableIndirection<Component>>
       u;
 };
 

flang/include/flang/Evaluate/tools.h

 std::optional<std::string> FindImpureCall(
     FoldingContext &, const Expr<SomeType> &);
 std::optional<std::string> FindImpureCall(
     FoldingContext &, const ProcedureRef &);
 
 // Predicate: is a scalar expression suitable for naive scalar expansion
 // in the flattening of an array expression?
 // TODO: capture such scalar expansions in temporaries, flatten everything
-struct UnexpandabilityFindingVisitor
+class UnexpandabilityFindingVisitor
     : public AnyTraverse<UnexpandabilityFindingVisitor> {
+public:
   using Base = AnyTraverse<UnexpandabilityFindingVisitor>;
   using Base::operator();
-  UnexpandabilityFindingVisitor() : Base{*this} {}
-  template <typename T> bool operator()(const FunctionRef<T> &) { return true; }
+  explicit UnexpandabilityFindingVisitor(bool admitPureCall)
+      : Base{*this}, admitPureCall_{admitPureCall} {}
+  template <typename T> bool operator()(const FunctionRef<T> &procRef) {
+    return !admitPureCall_ || !procRef.proc().IsPure();
+  }
   bool operator()(const CoarrayRef &) { return true; }
+
+private:
+  bool admitPureCall_{false};
 };
 
-template <typename T> bool IsExpandableScalar(const Expr<T> &expr) {
-  return !UnexpandabilityFindingVisitor{}(expr);
+template <typename T>
+bool IsExpandableScalar(const Expr<T> &expr, bool admitPureCall = false) {
+  return !UnexpandabilityFindingVisitor{admitPureCall}(expr);
 }
 
 // Common handling for procedure pointer compatibility of left- and right-hand
 // sides.  Returns nullopt if they're compatible.  Otherwise, it returns a
 // message that needs to be augmented by the names of the left and right sides
 std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
     const std::optional<characteristics::Procedure> &lhsProcedure,
     const characteristics::Procedure *rhsProcedure,

flang/lib/Evaluate/call.cpp

if (const Symbol * interface{GetInterfaceSymbol()}) {
     return intrinsic->characteristics.value().attrs.test(
         characteristics::Procedure::Attr::Elemental);
   } else {
     DIE("ProcedureDesignator::IsElemental(): no case");
   }
   return false;
 }
 
+bool ProcedureDesignator::IsPure() const {
+  if (const Symbol * interface{GetInterfaceSymbol()}) {
+    return IsPureProcedure(*interface);
+  } else if (const Symbol * symbol{GetSymbol()}) {
+    return IsPureProcedure(*symbol);
+  } else if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&u)}) {
+    return intrinsic->characteristics.value().attrs.test(
+        characteristics::Procedure::Attr::Pure);
+  } else {
+    DIE("ProcedureDesignator::IsPure(): no case");
+  }
+  return false;
+}
+
 const SpecificIntrinsic *ProcedureDesignator::GetSpecificIntrinsic() const {
   return std::get_if<SpecificIntrinsic>(&u);
 }
 
 const Component *ProcedureDesignator::GetComponent() const {
   if (auto *c{std::get_if<common::CopyableIndirection<Component>>(&u)}) {
     return &c->value();
   } else {

flang/lib/Semantics/expression.cpp

if (symbol) {
                     *symbol);
               } else {
                 auto checked{
                     CheckConformance(messages, *componentShape, *valueShape,
                         CheckConformanceFlags::RightIsExpandableDeferred,
                         "component", "value")};
                 if (checked && *checked && GetRank(*componentShape) > 0 &&
                     GetRank(*valueShape) == 0 &&
-                    !IsExpandableScalar(*converted)) {
+                    !IsExpandableScalar(*converted, true /*admit PURE call*/)) {
                   AttachDeclaration(
                       Say(expr.source,
                           "Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
                           symbol->name()),
                       *symbol);
                 }
                 if (checked.value_or(true)) {
                   result.Add(*symbol, std::move(*converted));