[flang] Fix off-by-one error in preprocessing expressions

Original-commit: flang-compiler/f18@4c08a4a1be Reviewed-on: https://github.com/flang-compiler/f18/pull/891
2019-12-20 13:03:30 -08:00 · 2019-12-20 13:03:30 -08:00 · 16c5b86368
parent f8393113f2
commit 16c5b86368
10 changed files with 225 additions and 98 deletions
--- a/flang/lib/evaluate/call.h
+++ b/flang/lib/evaluate/call.h
@ -204,7 +204,7 @@ template<typename A> class FunctionRef : public ProcedureRef {
 public:
  using Result = A;
  CLASS_BOILERPLATE(FunctionRef)
-  FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
+  explicit FunctionRef(ProcedureRef &&pr) : ProcedureRef{std::move(pr)} {}
  FunctionRef(ProcedureDesignator &&p, ActualArguments &&a)
    : ProcedureRef{std::move(p), std::move(a)} {}

--- a/flang/lib/evaluate/fold.cc
+++ b/flang/lib/evaluate/fold.cc
@ -981,8 +981,8 @@ Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
      context.messages().Say(
          "%s(real(kind=%d)) cannot be folded on host"_en_US, name, KIND);
    }
-  }
-  if (name == "atan" || name == "atan2" || name == "hypot" || name == "mod") {
+  } else if (name == "atan" || name == "atan2" || name == "hypot" ||
+      name == "mod") {
    std::string localName{name == "atan2" ? "atan" : name};
    CHECK(args.size() == 2);
    if (auto callable{
--- a/flang/lib/evaluate/shape.cc
+++ b/flang/lib/evaluate/shape.cc
@ -9,6 +9,7 @@
 #include "shape.h"
 #include "characteristics.h"
 #include "fold.h"
+#include "intrinsics.h"
 #include "tools.h"
 #include "type.h"
 #include "../common/idioms.h"
@ -503,6 +504,41 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
          return AsShape(context_, ConvertToType<ExtentType>(std::move(shape)));
        }
      }
+    } else if (intrinsic->name == "pack") {
+      if (call.arguments().size() >= 3 && call.arguments().at(2)) {
+        // SHAPE(PACK(,,VECTOR=v)) -> SHAPE(v)
+        return (*this)(call.arguments().at(2));
+      } else if (call.arguments().size() >= 2) {
+        if (auto maskShape{(*this)(call.arguments().at(1))}) {
+          if (maskShape->size() == 0) {
+            // Scalar MASK= -> [MERGE(SIZE(ARRAY=), 0, mask)]
+            if (auto arrayShape{(*this)(call.arguments().at(0))}) {
+              auto arraySize{GetSize(std::move(*arrayShape))};
+              CHECK(arraySize);
+              ActualArguments toMerge{
+                  ActualArgument{AsGenericExpr(std::move(*arraySize))},
+                  ActualArgument{AsGenericExpr(ExtentExpr{0})},
+                  common::Clone(call.arguments().at(1))};
+              auto specific{context_.intrinsics().Probe(
+                  CallCharacteristics{"merge"}, toMerge, context_)};
+              CHECK(specific);
+              return Shape{ExtentExpr{FunctionRef<ExtentType>{
+                  ProcedureDesignator{std::move(specific->specificIntrinsic)},
+                  std::move(specific->arguments)}}};
+            }
+          } else {
+            // Non-scalar MASK= -> [COUNT(mask)]
+            ActualArguments toCount{ActualArgument{common::Clone(
+                DEREF(call.arguments().at(1).value().UnwrapExpr()))}};
+            auto specific{context_.intrinsics().Probe(
+                CallCharacteristics{"count"}, toCount, context_)};
+            CHECK(specific);
+            return Shape{ExtentExpr{FunctionRef<ExtentType>{
+                ProcedureDesignator{std::move(specific->specificIntrinsic)},
+                std::move(specific->arguments)}}};
+          }
+        }
+      }
    } else if (intrinsic->name == "spread") {
      // SHAPE(SPREAD(ARRAY,DIM,NCOPIES)) = SHAPE(ARRAY) with NCOPIES inserted
      // at position DIM.
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@ -235,6 +235,19 @@ std::optional<DataRef> ExtractDataRef(const std::optional<A> &x) {
  }
 }

+// Predicate: is an expression is an array element reference?
+template<typename T> bool IsArrayElement(const Expr<T> &expr) {
+  if (auto dataRef{ExtractDataRef(expr)}) {
+    const DataRef *ref{&*dataRef};
+    while (const Component * component{std::get_if<Component>(&ref->u)}) {
+      ref = &component->base();
+    }
+    return std::holds_alternative<ArrayRef>(ref->u);
+  } else {
+    return false;
+  }
+}
+
 template<typename A> std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
  if (auto dataRef{ExtractDataRef(x)}) {
    return std::visit(
--- a/flang/lib/parser/preprocessor.cc
+++ b/flang/lib/parser/preprocessor.cc
@ -980,7 +980,7 @@ bool Preprocessor::IsIfPredicateTrue(const TokenSequence &expr,
        j += 3;
      } else if (j + 1 < expr1.SizeInTokens() &&
          IsLegalIdentifierStart(expr1.TokenAt(j + 1))) {
-        name = expr1.TokenAt(j++);
+        name = expr1.TokenAt(++j);
      }
      if (!name.empty()) {
        char truth{IsNameDefined(name) ? '1' : '0'};
--- a/flang/lib/semantics/check-call.cc
+++ b/flang/lib/semantics/check-call.cc
@ -137,14 +137,39 @@ static bool DefersSameTypeParameters(
 static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
    const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
    characteristics::TypeAndShape &actualType, bool isElemental,
-    evaluate::FoldingContext &context, const Scope *scope) {
+    bool actualIsArrayElement, evaluate::FoldingContext &context,
+    const Scope *scope) {

  // Basic type & rank checking
  parser::ContextualMessages &messages{context.messages()};
  PadShortCharacterActual(actual, dummy.type, actualType, messages);
  ConvertIntegerActual(actual, dummy.type, actualType, messages);
-  bool typesCompatible{dummy.type.IsCompatibleWith(
-      messages, actualType, "dummy argument", "actual argument", isElemental)};
+  bool typesCompatible{
+      dummy.type.type().IsTypeCompatibleWith(actualType.type())};
+  if (typesCompatible) {
+    if (isElemental) {
+    } else if (dummy.type.attrs().test(
+                   characteristics::TypeAndShape::Attr::AssumedRank)) {
+    } else if (!dummy.type.attrs().test(
+                   characteristics::TypeAndShape::Attr::AssumedShape) &&
+        (actualType.Rank() > 0 || actualIsArrayElement)) {
+      // Sequence association (15.5.2.11) applies -- rank need not match
+      // if the actual argument is an array or array element designator.
+    } else {
+      CheckConformance(messages, dummy.type.shape(), actualType.shape(),
+          "dummy argument", "actual argument");
+    }
+  } else {
+    std::stringstream lenStr;
+    if (const auto &len{actualType.LEN()}) {
+      len->AsFortran(lenStr);
+    }
+    messages.Say(
+        "Actual argument type '%s' is not compatible with dummy argument type '%s'"_err_en_US,
+        actualType.type().AsFortran(lenStr.str()),
+        dummy.type.type().AsFortran());
+  }
+
  bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
  bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
  bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
@ -577,7 +602,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
                      *expr, context)}) {
                bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
                CheckExplicitDataArg(object, dummyName, *expr, *type,
-                    isElemental, context, scope);
+                    isElemental, IsArrayElement(*expr), context, scope);
              } else if (object.type.type().IsTypelessIntrinsicArgument() &&
                  std::holds_alternative<evaluate::BOZLiteralConstant>(
                      expr->u)) {
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@ -625,7 +625,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::BOZLiteralConstant &x) {
    Say("BOZ literal '%s' too large"_err_en_US, x.v);
    return std::nullopt;
  }
-  return {AsGenericExpr(std::move(value.value))};
+  return AsGenericExpr(std::move(value.value));
 }

 // For use with SearchTypes to create a TypeParamInquiry with the
@ -1677,10 +1677,10 @@ static bool CheckCompatibleArguments(
 }

 // Resolve a call to a generic procedure with given actual arguments.
-// If it's a procedure component, base is the data-ref to the left of the '%'.
 // adjustActuals is called on procedure bindings to handle pass arg.
 const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
-    const ActualArguments &actuals, AdjustActuals adjustActuals) {
+    const ActualArguments &actuals, AdjustActuals adjustActuals,
+    bool mightBeStructureConstructor, bool inParentType) {
  const Symbol *elemental{nullptr};  // matching elemental specific proc
  const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
  for (const Symbol &specific : details.specificProcs()) {
@ -1711,10 +1711,20 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
  if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
    if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
      if (extended->GetUltimate().has<semantics::GenericDetails>()) {
-        return ResolveGeneric(*extended, actuals, adjustActuals);
+        if (const Symbol *
+            result{ResolveGeneric(
+                *extended, actuals, adjustActuals, false, true)}) {
+          return result;
+        }
      }
    }
  }
+  if (inParentType) {
+    return nullptr;  // emit error only at top level
+  }
+  if (mightBeStructureConstructor && details.derivedType()) {
+    return details.derivedType();
+  }
  if (semantics::IsGenericDefinedOp(symbol)) {
    Say("No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US,
        symbol.name());
@ -1727,12 +1737,13 @@ const Symbol *ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,

 auto ExpressionAnalyzer::GetCalleeAndArguments(
    const parser::ProcedureDesignator &pd, ActualArguments &&arguments,
-    bool isSubroutine) -> std::optional<CalleeAndArguments> {
+    bool isSubroutine, bool mightBeStructureConstructor)
+    -> std::optional<CalleeAndArguments> {
  return std::visit(
      common::visitors{
          [&](const parser::Name &name) {
-            return GetCalleeAndArguments(
-                name, std::move(arguments), isSubroutine);
+            return GetCalleeAndArguments(name, std::move(arguments),
+                isSubroutine, mightBeStructureConstructor);
          },
          [&](const parser::ProcComponentRef &pcr) {
            return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
@ -1741,12 +1752,12 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
      pd.u);
 }

-auto ExpressionAnalyzer::GetCalleeAndArguments(
-    const parser::Name &name, ActualArguments &&arguments, bool isSubroutine)
-    -> std::optional<CalleeAndArguments> {
+auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
+    ActualArguments &&arguments, bool isSubroutine,
+    bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
  const Symbol *symbol{name.symbol};
  if (context_.HasError(symbol)) {
-    return std::nullopt;
+    return std::nullopt;  // also handles null symbol
  }
  const Symbol &ultimate{DEREF(symbol).GetUltimate()};
  if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
@ -1756,21 +1767,26 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
      return CalleeAndArguments{
          ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
          std::move(specificCall->arguments)};
-    } else {
-      return std::nullopt;
    }
  } else {
    CheckForBadRecursion(name.source, ultimate);
    if (ultimate.has<semantics::GenericDetails>()) {
-      symbol = ResolveGeneric(*symbol, arguments);
+      symbol = ResolveGeneric(
+          *symbol, arguments, std::nullopt, mightBeStructureConstructor);
    }
    if (symbol) {
-      return CalleeAndArguments{
-          ProcedureDesignator{*symbol}, std::move(arguments)};
-    } else {
-      return std::nullopt;
+      if (symbol->GetUltimate().has<semantics::DerivedTypeDetails>()) {
+        if (mightBeStructureConstructor) {
+          return CalleeAndArguments{
+              semantics::SymbolRef{*symbol}, std::move(arguments)};
+        }
+      } else {
+        return CalleeAndArguments{
+            ProcedureDesignator{*symbol}, std::move(arguments)};
+      }
    }
  }
+  return std::nullopt;
 }

 void ExpressionAnalyzer::CheckForBadRecursion(
@ -1810,46 +1826,67 @@ template<typename A> static const Symbol *AssumedTypeDummy(const A &x) {
  return nullptr;
 }

-MaybeExpr ExpressionAnalyzer::Analyze(
-    const parser::FunctionReference &funcRef) {
-  return AnalyzeCall(funcRef.v, false);
-}
-
-void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
-  MaybeExpr expr{AnalyzeCall(callStmt.v, true)};
-  if (const auto *proc{UnwrapExpr<ProcedureRef>(expr)}) {
-    callStmt.typedCall.reset(new ProcedureRef{*proc});
-  }
-}
-
-MaybeExpr ExpressionAnalyzer::AnalyzeCall(
-    const parser::Call &call, bool isSubroutine) {
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
+    std::optional<parser::StructureConstructor> *structureConstructor) {
+  const parser::Call &call{funcRef.v};
  auto restorer{GetContextualMessages().SetLocation(call.source)};
  ArgumentAnalyzer analyzer{*this};
  for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
-    analyzer.Analyze(arg, isSubroutine);
+    analyzer.Analyze(arg, false /* not subroutine call */);
  }
-  if (!analyzer.fatalErrors()) {
-    if (std::optional<CalleeAndArguments> callee{
-            GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
-                analyzer.GetActuals(), isSubroutine)}) {
-      if (isSubroutine) {
-        if (CheckCall(
-                call.source, callee->procedureDesignator, callee->arguments)) {
-          return Expr<SomeType>{
-              ProcedureRef{std::move(callee->procedureDesignator),
-                  std::move(callee->arguments)}};
-        }
-      } else {
-        return MakeFunctionRef(call.source,
-            std::move(callee->procedureDesignator),
-            std::move(callee->arguments));
+  if (analyzer.fatalErrors()) {
+    return std::nullopt;
+  }
+  if (std::optional<CalleeAndArguments> callee{
+          GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
+              analyzer.GetActuals(), false /* not subroutine */,
+              true /* might be structure constructor */)}) {
+    if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
+      return MakeFunctionRef(
+          call.source, std::move(*proc), std::move(callee->arguments));
+    } else if (structureConstructor) {
+      // Structure constructor misparsed as function reference?
+      CHECK(std::holds_alternative<semantics::SymbolRef>(callee->u));
+      const Symbol &derivedType{*std::get<semantics::SymbolRef>(callee->u)};
+      const auto &designator{std::get<parser::ProcedureDesignator>(call.t)};
+      if (const auto *name{std::get_if<parser::Name>(&designator.u)}) {
+        semantics::Scope &scope{context_.FindScope(name->source)};
+        const semantics::DeclTypeSpec &type{
+            semantics::FindOrInstantiateDerivedType(scope,
+                semantics::DerivedTypeSpec{
+                    name->source, derivedType.GetUltimate()},
+                context_)};
+        auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
+        *structureConstructor =
+            mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
+        return Analyze(structureConstructor->value());
      }
    }
  }
  return std::nullopt;
 }

+void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) {
+  const parser::Call &call{callStmt.v};
+  auto restorer{GetContextualMessages().SetLocation(call.source)};
+  ArgumentAnalyzer analyzer{*this};
+  for (const auto &arg : std::get<std::list<parser::ActualArgSpec>>(call.t)) {
+    analyzer.Analyze(arg, true /* is subroutine call */);
+  }
+  if (!analyzer.fatalErrors()) {
+    if (std::optional<CalleeAndArguments> callee{
+            GetCalleeAndArguments(std::get<parser::ProcedureDesignator>(call.t),
+                analyzer.GetActuals(), true /* subroutine */)}) {
+      ProcedureDesignator *proc{std::get_if<ProcedureDesignator>(&callee->u)};
+      CHECK(proc);
+      if (CheckCall(call.source, *proc, callee->arguments)) {
+        callStmt.typedCall.reset(
+            new ProcedureRef{std::move(*proc), std::move(callee->arguments)});
+      }
+    }
+  }
+}
+
 const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
  if (!x.typedAssignment) {
    ArgumentAnalyzer analyzer{*this};
@ -1986,8 +2023,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
  analyzer.Analyze(std::get<1>(x.t));
  if (!analyzer.fatalErrors()) {
    if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
+      CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
      return MakeFunctionRef(name.source,
-          std::move(callee->procedureDesignator), std::move(callee->arguments));
+          std::move(std::get<ProcedureDesignator>(callee->u)),
+          std::move(callee->arguments));
    }
  }
  return std::nullopt;
@ -2073,7 +2112,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
 MaybeExpr ExpressionAnalyzer::AnalyzeDefinedOp(
    const parser::Name &name, ActualArguments &&actuals) {
  if (auto callee{GetCalleeAndArguments(name, std::move(actuals))}) {
-    return MakeFunctionRef(name.source, std::move(callee->procedureDesignator),
+    CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
+    return MakeFunctionRef(name.source,
+        std::move(std::get<ProcedureDesignator>(callee->u)),
        std::move(callee->arguments));
  } else {
    return std::nullopt;
@ -2160,8 +2201,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
  analyzer.Analyze(std::get<2>(x.t));
  if (!analyzer.fatalErrors()) {
    if (auto callee{GetCalleeAndArguments(name, analyzer.GetActuals())}) {
+      CHECK(std::holds_alternative<ProcedureDesignator>(callee->u));
      return MakeFunctionRef(name.source,
-          std::move(callee->procedureDesignator), std::move(callee->arguments));
+          std::move(std::get<ProcedureDesignator>(callee->u)),
+          std::move(callee->arguments));
    }
  }
  return std::nullopt;
@ -2170,7 +2213,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &x) {
 static void CheckFuncRefToArrayElementRefHasSubscripts(
    semantics::SemanticsContext &context,
    const parser::FunctionReference &funcRef) {
-  // Emit message if the function reference fix will end-up an array element
+  // Emit message if the function reference fix will end up an array element
  // reference with no subscripts because it will not be possible to later tell
  // the difference in expressions between empty subscript list due to bad
  // subscripts error recovery or because the user did not put any.
@ -2196,8 +2239,9 @@ static void CheckFuncRefToArrayElementRefHasSubscripts(
 }

 // Converts, if appropriate, an original misparse of ambiguous syntax like
-// A(1) as a function reference into an array reference or a structure
-// constructor.
+// A(1) as a function reference into an array reference.
+// Misparse structure constructors are detected elsewhere after generic
+// function call resolution fails.
 template<typename... A>
 static void FixMisparsedFunctionReference(
    semantics::SemanticsContext &context, const std::variant<A...> &constU) {
@ -2229,30 +2273,6 @@ static void FixMisparsedFunctionReference(
        } else {
          DIE("can't fix misparsed function as array reference");
        }
-      } else if (const auto *name{std::get_if<parser::Name>(&proc.u)}) {
-        // A procedure component reference can't be a structure
-        // constructor; only check calls to bare names.
-        const Symbol *derivedType{nullptr};
-        if (symbol.has<semantics::DerivedTypeDetails>()) {
-          derivedType = &symbol;
-        } else if (const auto *generic{
-                       symbol.detailsIf<semantics::GenericDetails>()}) {
-          derivedType = generic->derivedType();
-        }
-        if (derivedType) {
-          if constexpr (common::HasMember<parser::StructureConstructor,
-                            uType>) {
-            auto &scope{context.FindScope(name->source)};
-            const semantics::DeclTypeSpec &type{
-                semantics::FindOrInstantiateDerivedType(scope,
-                    semantics::DerivedTypeSpec{
-                        origSymbol->name(), *derivedType},
-                    context)};
-            u = funcRef.ConvertToStructureConstructor(type.derivedTypeSpec());
-          } else {
-            DIE("can't fix misparsed function as structure constructor");
-          }
-        }
      }
    }
  }
--- a/flang/lib/semantics/expression.h
+++ b/flang/lib/semantics/expression.h
@ -255,7 +255,8 @@ private:
  MaybeExpr Analyze(const parser::CharLiteralConstantSubstring &);
  MaybeExpr Analyze(const parser::ArrayConstructor &);
  MaybeExpr Analyze(const parser::StructureConstructor &);
-  MaybeExpr Analyze(const parser::FunctionReference &);
+  MaybeExpr Analyze(const parser::FunctionReference &,
+      std::optional<parser::StructureConstructor> * = nullptr);
  MaybeExpr Analyze(const parser::Expr::Parentheses &);
  MaybeExpr Analyze(const parser::Expr::UnaryPlus &);
  MaybeExpr Analyze(const parser::Expr::Negate &);
@ -284,7 +285,35 @@ private:
    return Analyze(x.u);  // default case
  }
  template<typename... As> MaybeExpr Analyze(const std::variant<As...> &u) {
-    return std::visit([&](const auto &x) { return Analyze(x); }, u);
+    return std::visit(
+        [&](const auto &x) {
+          using Ty = std::decay_t<decltype(x)>;
+          // Function references might turn out to be misparsed structure
+          // constructors; we have to try generic procedure resolution
+          // first to be sure.
+          if constexpr (common::IsTypeInList<parser::StructureConstructor,
+                            As...>) {
+            std::optional<parser::StructureConstructor> ctor;
+            MaybeExpr result;
+            if constexpr (std::is_same_v<Ty,
+                              common::Indirection<parser::FunctionReference>>) {
+              result = Analyze(x.value(), &ctor);
+            } else if constexpr (std::is_same_v<Ty,
+                                     parser::FunctionReference>) {
+              result = Analyze(x, &ctor);
+            } else {
+              return Analyze(x);
+            }
+            if (ctor) {
+              // A misparsed function reference is really a structure
+              // constructor.  Repair the parse tree in situ.
+              const_cast<std::variant<As...> &>(u) = std::move(*ctor);
+            }
+            return result;
+          }
+          return Analyze(x);
+        },
+        u);
  }

  // Analysis subroutines
@ -309,7 +338,10 @@ private:
  MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);

  struct CalleeAndArguments {
-    ProcedureDesignator procedureDesignator;
+    // A non-component function reference may constitute a misparsed
+    // structure constructor, in which case its derived type's Symbol
+    // will appear here.
+    std::variant<ProcedureDesignator, SymbolRef> u;
    ActualArguments arguments;
  };

@ -317,20 +349,21 @@ private:
      const parser::ProcComponentRef &, ActualArguments &&);
  std::optional<ActualArgument> AnalyzeActualArgument(const parser::Expr &);

-  MaybeExpr AnalyzeCall(const parser::Call &, bool isSubroutine);
  std::optional<ActualArguments> AnalyzeArguments(
      const parser::Call &, bool isSubroutine);
  std::optional<characteristics::Procedure> CheckCall(
      parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
  using AdjustActuals =
      std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
-  const Symbol *ResolveGeneric(
-      const Symbol &, const ActualArguments &, AdjustActuals = std::nullopt);
-  std::optional<CalleeAndArguments> GetCalleeAndArguments(
-      const parser::Name &, ActualArguments &&, bool isSubroutine = false);
+  const Symbol *ResolveGeneric(const Symbol &, const ActualArguments &,
+      AdjustActuals = std::nullopt, bool mightBeStructureConstructor = false,
+      bool inParentType = false);
+  std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
+      ActualArguments &&, bool isSubroutine = false,
+      bool mightBeStructureConstructor = false);
  std::optional<CalleeAndArguments> GetCalleeAndArguments(
      const parser::ProcedureDesignator &, ActualArguments &&,
-      bool isSubroutine);
+      bool isSubroutine, bool mightBeStructureConstructor = false);

  void CheckForBadRecursion(parser::CharBlock, const semantics::Symbol &);
  bool EnforceTypeConstraint(parser::CharBlock, const MaybeExpr &, TypeCategory,
--- a/flang/lib/semantics/type.h
+++ b/flang/lib/semantics/type.h
@ -233,7 +233,7 @@ public:
  using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
  using RawParameters = std::vector<RawParameter>;
  using ParameterMapType = std::map<SourceName, ParamValue>;
-  explicit DerivedTypeSpec(SourceName, const Symbol &);
+  DerivedTypeSpec(SourceName, const Symbol &);
  DerivedTypeSpec(const DerivedTypeSpec &);
  DerivedTypeSpec(DerivedTypeSpec &&);

--- a/flang/test/semantics/call05.f90
+++ b/flang/test/semantics/call05.f90
@ -84,9 +84,9 @@ module m
    call sup(pp)
    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
    call sua(pa)
-    !ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
+    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
    call spp(up)
-    !ERROR: actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
+    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
    call spa(ua)
    !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type
    call spp(pp2)