[flang] Handle parameter-dependent types in PDT initializers

[klausler]

Summary

For parameterized derived type component initializers whose
expressions' types depend on parameter values, f18's current
scheme of analyzing the initialization expression once during
name resolution fails. For example,

type :: pdt(k)
  integer, kind :: k
  real :: component = real(0.0, kind=k)
end type

To handle such cases, it is necessary to re-analyze the parse
trees of these initialization expressions once for each distinct
initialization of the type.

This patch adds code to wipe an expression parse tree of its
typed expressions, and update those of its symbol table pointers
that reference type parameters, and then re-analyze that parse
tree to generate the properly typed component initializers.

[clementval]

LGTM

[klausler]

Rebase to pick up GetExpr() changes on which this fix depends.

[klausler]

Patch around MSVC-specific C++ error message.

flang/include/flang/Common/indirection.h

public:
   operator bool() const { return p_ != nullptr; }
   A *get() { return p_; }
   A *release() {
     A *result{p_};
     p_ = nullptr;
     return result;
   }
 
-  void Reset(A *p, void (*del)(A *)) {
+  void Reset(A *p = nullptr) {
     if (p_) {
       deleter_(p_);
     }
     p_ = p;
+  }
+  void Reset(A *p, void (*del)(A *)) {
+    Reset(p);
     deleter_ = del;
   }
 
 private:
   A *p_{nullptr};
   void (*deleter_)(A *){nullptr};
 };
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_INDIRECTION_H_

flang/include/flang/Parser/unparse.h

 struct GenericExprWrapper;
 struct GenericAssignmentWrapper;
 class ProcedureRef;
 } // namespace Fortran::evaluate
 
 namespace Fortran::parser {
 
 struct Program;
+struct Expr;
 
 // A function called before each Statement is unparsed.
 using preStatementType =
     std::function<void(const CharBlock &, llvm::raw_ostream &, int)>;
 
 // Functions to handle unparsing of analyzed expressions and related
 // objects rather than their original parse trees.
 struct AnalyzedObjectsAsFortran {
   std::function<void(llvm::raw_ostream &, const evaluate::GenericExprWrapper &)>
       expr;
   std::function<void(
       llvm::raw_ostream &, const evaluate::GenericAssignmentWrapper &)>
       assignment;
   std::function<void(llvm::raw_ostream &, const evaluate::ProcedureRef &)> call;
 };
 
-// Converts parsed program to out as Fortran.
-void Unparse(llvm::raw_ostream &out, const Program &program,
+// Converts parsed program (or fragment) to out as Fortran.
+template <typename A>
+void Unparse(llvm::raw_ostream &out, const A &root,
     Encoding encoding = Encoding::UTF_8, bool capitalizeKeywords = true,
     bool backslashEscapes = true, preStatementType *preStatement = nullptr,
     AnalyzedObjectsAsFortran * = nullptr);
+
+extern template void Unparse(llvm::raw_ostream &out, const Program &program,
+    Encoding encoding, bool capitalizeKeywords, bool backslashEscapes,
+    preStatementType *preStatement, AnalyzedObjectsAsFortran *);
+extern template void Unparse(llvm::raw_ostream &out, const Expr &expr,
+    Encoding encoding, bool capitalizeKeywords, bool backslashEscapes,
+    preStatementType *preStatement, AnalyzedObjectsAsFortran *);
 } // namespace Fortran::parser
 
 #endif

flang/include/flang/Semantics/expression.h

bool Pre(const parser::WhereBodyConstruct &) {
     exprAnalyzer_.set_inWhereBody(InWhereBody());
     return true;
   }
   void Post(const parser::WhereBodyConstruct &) {
     --whereDepth_;
     exprAnalyzer_.set_inWhereBody(InWhereBody());
   }
 
+  bool Pre(const parser::ComponentDefStmt &) {
+    // Already analyzed in name resolution and PDT instantiation;
+    // do not attempt to re-analyze now without type parameters.
+    return false;
+  }
+
   template <typename A> bool Pre(const parser::Scalar<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }
   template <typename A> bool Pre(const parser::Constant<A> &x) {
     exprAnalyzer_.Analyze(x);
     return false;
   }

flang/include/flang/Semantics/symbol.h

 #include <list>
 #include <optional>
 #include <set>
 #include <vector>
 
 namespace llvm {
 class raw_ostream;
 }
+namespace Fortran::parser {
+struct Expr;
+}
 
 namespace Fortran::semantics {
 
 /// A Symbol consists of common information (name, owner, and attributes)
 /// and details information specific to the kind of symbol, represented by the
 /// *Details classes.
 
 class Scope;

 public:
   explicit ObjectEntityDetails(EntityDetails &&);
   ObjectEntityDetails(const ObjectEntityDetails &) = default;
   ObjectEntityDetails &operator=(const ObjectEntityDetails &) = default;
   ObjectEntityDetails(bool isDummy = false) : EntityDetails(isDummy) {}
   MaybeExpr &init() { return init_; }
   const MaybeExpr &init() const { return init_; }
   void set_init(MaybeExpr &&expr) { init_ = std::move(expr); }
+  const parser::Expr *unanalyzedPDTComponentInit() const {
+    return unanalyzedPDTComponentInit_;
+  }
+  void set_unanalyzedPDTComponentInit(const parser::Expr *expr) {
+    unanalyzedPDTComponentInit_ = expr;
+  }
   ArraySpec &shape() { return shape_; }
   const ArraySpec &shape() const { return shape_; }
   ArraySpec &coshape() { return coshape_; }
   const ArraySpec &coshape() const { return coshape_; }
   void set_shape(const ArraySpec &);
   void set_coshape(const ArraySpec &);
   const Symbol *commonBlock() const { return commonBlock_; }
   void set_commonBlock(const Symbol &commonBlock) {
     commonBlock_ = &commonBlock;
   }
   bool IsArray() const { return !shape_.empty(); }
   bool IsCoarray() const { return !coshape_.empty(); }
   bool CanBeAssumedShape() const {
     return isDummy() && shape_.CanBeAssumedShape();
   }
   bool CanBeDeferredShape() const { return shape_.CanBeDeferredShape(); }
   bool IsAssumedSize() const { return isDummy() && shape_.CanBeAssumedSize(); }
   bool IsAssumedRank() const { return isDummy() && shape_.IsAssumedRank(); }
 
 private:
   MaybeExpr init_;
+  const parser::Expr *unanalyzedPDTComponentInit_{nullptr};
   ArraySpec shape_;
   ArraySpec coshape_;
   const Symbol *commonBlock_{nullptr}; // common block this object is in
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const ObjectEntityDetails &);
 };
 
 // Mixin for details with passed-object dummy argument.

flang/lib/Parser/unparse.cpp

 void UnparseVisitor::Word(const char *str) {
   for (; *str != '\0'; ++str) {
     PutKeywordLetter(*str);
   }
 }
 
 void UnparseVisitor::Word(const std::string &str) { Word(str.c_str()); }
 
-void Unparse(llvm::raw_ostream &out, const Program &program, Encoding encoding,
+template <typename A>
+void Unparse(llvm::raw_ostream &out, const A &root, Encoding encoding,
     bool capitalizeKeywords, bool backslashEscapes,
     preStatementType *preStatement, AnalyzedObjectsAsFortran *asFortran) {
   UnparseVisitor visitor{out, 1, encoding, capitalizeKeywords, backslashEscapes,
       preStatement, asFortran};
-  Walk(program, visitor);
+  Walk(root, visitor);
   visitor.Done();
 }
+
+template void Unparse<Program>(llvm::raw_ostream &, const Program &, Encoding,
+    bool, bool, preStatementType *, AnalyzedObjectsAsFortran *);
+template void Unparse<Expr>(llvm::raw_ostream &, const Expr &, Encoding, bool,
+    bool, preStatementType *, AnalyzedObjectsAsFortran *);
 } // namespace Fortran::parser

flang/lib/Semantics/expression.cpp

 }
 
 // Names and named constants
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
   auto restorer{GetContextualMessages().SetLocation(n.source)};
   if (std::optional<int> kind{IsImpliedDo(n.source)}) {
     return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
         *kind, AsExpr(ImpliedDoIndex{n.source})));
-  } else if (context_.HasError(n)) {
-    return std::nullopt;
-  } else if (!n.symbol) {
-    SayAt(n, "Internal error: unresolved name '%s'"_err_en_US, n.source);
+  }
+  if (context_.HasError(n.symbol)) { // includes case of no symbol
     return std::nullopt;
   } else {
     const Symbol &ultimate{n.symbol->GetUltimate()};
     if (ultimate.has<semantics::TypeParamDetails>()) {
       // A bare reference to a derived type parameter (within a parameterized
       // derived type definition)
       return Fold(ConvertToType(
           ultimate, AsGenericExpr(TypeParamInquiry{std::nullopt, ultimate})));

flang/lib/Semantics/mod-file.cpp

 //===-- lib/Semantics/mod-file.cpp ----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "mod-file.h"
 #include "resolve-names.h"
 #include "flang/Common/restorer.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/message.h"
 #include "flang/Parser/parsing.h"
+#include "flang/Parser/unparse.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/FileSystem.h"
 #include "llvm/Support/MemoryBuffer.h"
 #include "llvm/Support/raw_ostream.h"
 #include <algorithm>
struct ModHeader {
   static constexpr const char magic[magicLen + 1]{"!mod$ v1 sum:"};
   static constexpr char terminator{'\n'};
   static constexpr int len{magicLen + 1 + sumLen};
 };
 
 static std::optional<SourceName> GetSubmoduleParent(const parser::Program &);
 static void CollectSymbols(const Scope &, SymbolVector &, SymbolVector &);
 static void PutPassName(llvm::raw_ostream &, const std::optional<SourceName> &);
-static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &);
+static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &,
+    const parser::Expr *);
 static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
 static void PutBound(llvm::raw_ostream &, const Bound &);
 static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
 static void PutShape(
     llvm::raw_ostream &, const ArraySpec &, char open, char close);
 llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
     const std::string * = nullptr, std::string before = ","s,
     std::string after = ""s);
for (const auto &ref : scope->GetSymbols()) {
           &object->type()->derivedTypeSpec().typeSymbol() == &typeSymbol) {
         if (any) {
           decls_ << ',';
         } else {
           any = true;
         }
         decls_ << ref->name();
         PutShape(decls_, object->shape(), '(', ')');
-        PutInit(decls_, *ref, object->init());
+        PutInit(decls_, *ref, object->init(), nullptr);
         emittedDECFields_.insert(*ref);
       } else if (any) {
         break; // any later use of this structure will use RECORD/str/
       }
     }
   }
   decls_ << '\n';
   PutComponents(typeSymbol);
if (typeSymbol.get<DerivedTypeDetails>().isDECStructure()) {
       }
     }
   }
   PutEntity(
       os, symbol, [&]() { PutType(os, DEREF(symbol.GetType())); },
       symbol.attrs());
   PutShape(os, details.shape(), '(', ')');
   PutShape(os, details.coshape(), '[', ']');
-  PutInit(os, symbol, details.init());
+  PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit());
   os << '\n';
 }
 
 void ModFileWriter::PutProcEntity(llvm::raw_ostream &os, const Symbol &symbol) {
   if (symbol.attrs().test(Attr::INTRINSIC)) {
     os << "intrinsic::" << symbol.name() << '\n';
     if (symbol.attrs().test(Attr::PRIVATE)) {
       os << "private::" << symbol.name() << '\n';
PutEntity(
         PutType(os, DEREF(symbol.GetType()));
         PutLower(os << ',', common::EnumToString(details.attr()));
       },
       symbol.attrs());
   PutInit(os, details.init());
   os << '\n';
 }
 
-void PutInit(
-    llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init) {
-  if (init) {
-    if (symbol.attrs().test(Attr::PARAMETER) ||
-        symbol.owner().IsDerivedType()) {
-      os << (symbol.attrs().test(Attr::POINTER) ? "=>" : "=");
-      init->AsFortran(os);
+void PutInit(llvm::raw_ostream &os, const Symbol &symbol, const MaybeExpr &init,
+    const parser::Expr *unanalyzed) {
+  if (symbol.attrs().test(Attr::PARAMETER) || symbol.owner().IsDerivedType()) {
+    const char *assign{symbol.attrs().test(Attr::POINTER) ? "=>" : "="};
+    if (unanalyzed) {
+      parser::Unparse(os << assign, *unanalyzed);
+    } else if (init) {
+      init->AsFortran(os << assign);
     }
   }
 }
 
 void PutInit(llvm::raw_ostream &os, const MaybeIntExpr &init) {
   if (init) {
     init->AsFortran(os << '=');
   }

flang/lib/Semantics/resolve-names.cpp

if (name.symbol) {
     if (!context().HasError(ultimate) && !context().HasError(name.symbol)) {
       if (IsPointer(ultimate)) {
         Say(name,
             "'%s' is a pointer but is not initialized like one"_err_en_US);
       } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
         CHECK(!details->init());
         Walk(expr);
         if (ultimate.owner().IsParameterizedDerivedType()) {
-          // Can't convert to type of component, which might not yet
-          // be known; that's done later during PDT instantiation.
-          if (MaybeExpr value{EvaluateExpr(expr)}) {
-            details->set_init(std::move(*value));
-          }
-        } else if (MaybeExpr folded{EvaluateNonPointerInitializer(
-                       ultimate, expr, expr.thing.value().source)}) {
+          // Save the expression for per-instantiation analysis.
+          details->set_unanalyzedPDTComponentInit(&expr.thing.value());
+        } else {
+          if (MaybeExpr folded{EvaluateNonPointerInitializer(
             details->set_init(std::move(*folded));
           }
         }
       }
     }
   }
+}
 
 void ResolveNamesVisitor::HandleCall(
     Symbol::Flag procFlag, const parser::Call &call) {
   std::visit(
       common::visitors{
           [&](const parser::Name &x) { HandleProcedureName(procFlag, x); },
           [&](const parser::ProcComponentRef &x) { Walk(x); },
       },

flang/lib/Semantics/symbol.cpp

 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const ObjectEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   DumpList(os, "shape", x.shape());
   DumpList(os, "coshape", x.coshape());
   DumpExpr(os, "init", x.init_);
+  if (x.unanalyzedPDTComponentInit()) {
+    os << " (has unanalyzedPDTComponentInit)";
+  }
   return os;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const AssocEntityDetails &x) {
   os << *static_cast<const EntityDetails *>(&x);
   if (auto assocRank{x.rank()}) {
     os << " rank: " << *assocRank;

flang/lib/Semantics/type.cpp

 //===-- lib/Semantics/type.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Semantics/type.h"
 #include "check-declarations.h"
 #include "compute-offsets.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/characters.h"
+#include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/raw_ostream.h"
 
 namespace Fortran::semantics {
 
 DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol)

 
 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
   for (const auto &pair : fromScope) {
     InstantiateComponent(*pair.second);
   }
   ComputeOffsets(context(), scope_);
 }
 
+// Walks a parsed expression to prepare it for (re)analysis;
+// clears out the typedExpr analysis results and re-resolves
+// symbol table pointers of type parameters.
+class ComponentInitResetHelper {
+public:
+  explicit ComponentInitResetHelper(Scope &scope) : scope_{scope} {}
+
+  template <typename A> bool Pre(const A &) { return true; }
+
+  template <typename A> void Post(const A &x) {
+    if constexpr (parser::HasTypedExpr<A>()) {
+      x.typedExpr.Reset();
+    }
+  }
+
+  void Post(const parser::Name &name) {
+    if (name.symbol && name.symbol->has<TypeParamDetails>()) {
+      name.symbol = scope_.FindSymbol(name.source);
+    }
+  }
+
+private:
+  Scope &scope_;
+};
+
 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
   auto pair{scope_.try_emplace(
       oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))};
   Symbol &newSymbol{*pair.first->second};
   if (!pair.second) {
     // Symbol was already present in the scope, which can only happen
     // in the case of type parameters.
     CHECK(oldSymbol.has<TypeParamDetails>());
if (auto *details{newSymbol.detailsIf<ObjectEntityDetails>()}) {
     for (ShapeSpec &dim : details->coshape()) {
       if (dim.lbound().isExplicit()) {
         dim.lbound().SetExplicit(Fold(std::move(dim.lbound().GetExplicit())));
       }
       if (dim.ubound().isExplicit()) {
         dim.ubound().SetExplicit(Fold(std::move(dim.ubound().GetExplicit())));
       }
     }
+    if (const auto *parsedExpr{details->unanalyzedPDTComponentInit()}) {
+      // Analyze the parsed expression in this PDT instantiation context.
+      ComponentInitResetHelper resetter{scope_};
+      parser::Walk(*parsedExpr, resetter);
+      auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
+      details->set_init(evaluate::Fold(
+          foldingContext(), AnalyzeExpr(context(), *parsedExpr)));
+      details->set_unanalyzedPDTComponentInit(nullptr);
+      // Remove analysis results to prevent unparsing or other use of
+      // instantiation-specific expressions.
+      parser::Walk(*parsedExpr, resetter);
+    }
     if (MaybeExpr & init{details->init()}) {
       // Non-pointer components with default initializers are
       // processed now so that those default initializers can be used
       // in PARAMETER structure constructors.
       auto restorer{foldingContext().messages().SetLocation(newSymbol.name())};
       init = IsPointer(newSymbol)
           ? Fold(std::move(*init))
           : evaluate::NonPointerInitializationExpr(

flang/test/Semantics/init01.f90

!ERROR: Rank of initialized object is 0, but initialization expression has rank 1
   real :: x7 = [1.]
   real :: x8(2,2) = reshape([1., 2., 3., 4.], [2, 2])
 !ERROR: Dimension 1 of initialized object has extent 3, but initialization expression has extent 2
   real :: x9(3) = [1., 2.]
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
   real :: x10(2,3) = reshape([real::(k,k=1,6)], [3, 2])
 end subroutine
 
-subroutine components
+subroutine components(n)
+  integer, intent(in) :: n
   real, target, save :: a1(3)
   real, target :: a2
   real, save :: a3
   real, target, save :: a4
   type :: t1
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
     real :: x1(2) = [1., 2., 3.]
   end type
   type :: t2(kind, len)
     integer, kind :: kind
     integer, len :: len
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
     real :: x1(2) = [1., 2., 3.]
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
     real :: x2(kind) = [1., 2., 3.]
 !ERROR: Dimension 1 of initialized object has extent 2, but initialization expression has extent 3
-!ERROR: An automatic variable or component must not be initialized
+!ERROR: Shape of initialized object 'x3' must be constant
     real :: x3(len) = [1., 2., 3.]
     real, pointer :: p1(:) => a1
 !ERROR: An initial data target may not be a reference to an object 'a2' that lacks the SAVE attribute
 !ERROR: An initial data target may not be a reference to an object 'a2' that lacks the SAVE attribute
     real, pointer :: p2 => a2
 !ERROR: An initial data target may not be a reference to an object 'a3' that lacks the TARGET attribute
 !ERROR: An initial data target may not be a reference to an object 'a3' that lacks the TARGET attribute
     real, pointer :: p3 => a3
 !ERROR: Pointer has rank 0 but target has rank 1
 !ERROR: Pointer has rank 0 but target has rank 1
     real, pointer :: p4 => a1
 !ERROR: Pointer has rank 1 but target has rank 0
 !ERROR: Pointer has rank 1 but target has rank 0
     real, pointer :: p5(:) => a4
   end type
-  type(t2(3,3)) :: o1
-  type(t2(2,2)) :: o2
+  type(t2(3,2)) :: o1
+  type(t2(2,n)) :: o2
   type :: t3
     real :: x
   end type
   type(t3), save, target :: o3
   real, pointer :: p10 => o3%x
   associate (a1 => o3, a2 => o3%x)
     block
       real, pointer :: p11 => a1
       real, pointer :: p12 => a2
     end block
   end associate
 end subroutine

flang/test/Semantics/modfile48.f90

+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Ensure proper formatting of component initializers in PDTs;
+! they should be unparsed from their parse trees.
+module m
+  type :: t(k)
+    integer, kind :: k
+    real(kind=k) :: x = real(0., kind=k)
+  end type
+end module
+
+!Expect: m.mod
+!module m
+!type::t(k)
+!integer(4),kind::k
+!real(int(int(k,kind=4),kind=8))::x=real(0., kind=k)
+!end type
+!intrinsic::real
+!end

flang/test/Semantics/structconst02.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Error tests for structure constructors: per-component type
 ! (in)compatibility.
 
 module module1
   interface
     real function realfunc(x)
       real, value :: x
     end function realfunc
   end interface
   type :: scalar(ik,rk,zk,ck,lk,len)
     integer, kind :: ik = 4, rk = 4, zk = 4, ck = 1, lk = 1
     integer, len :: len = 1
-    integer(kind=ik) :: ix = 0
-    real(kind=rk) :: rx = 0.
-    complex(kind=zk) :: zx = (0.,0.)
-    !ERROR: An automatic variable or component must not be initialized
+    integer(kind=ik) :: ix = int(0,kind=ik)
+    real(kind=rk) :: rx = real(0.,kind=rk)
+    complex(kind=zk) :: zx = cmplx(0.,0.,kind=zk)
+    !ERROR: Initialization expression for 'cx' (%SET_LENGTH(" ",len)) cannot be computed as a constant value
     character(kind=ck,len=len) :: cx = ' '
     logical(kind=lk) :: lx = .false.
     real(kind=rk), pointer :: rp => NULL()
     procedure(realfunc), pointer, nopass :: rfp1 => NULL()
     procedure(real), pointer, nopass :: rfp2 => NULL()
   end type scalar
  contains
   subroutine scalararg(x)
     type(scalar), intent(in) :: x
   end subroutine scalararg
-  subroutine errors
+  subroutine errors(n)
+    integer, intent(in) :: n
+    call scalararg(scalar(4)()) ! ok
+    !ERROR: Structure constructor lacks a value for component 'cx'
+    call scalararg(scalar(len=n)()) ! triggers error on 'cx'
     call scalararg(scalar(4)(ix=1,rx=2.,zx=(3.,4.),cx='a',lx=.true.))
     call scalararg(scalar(4)(1,2.,(3.,4.),'a',.true.))
 !    call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true._4))
 !    call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true._4))
     call scalararg(scalar(4)(ix=5.,rx=6,zx=(7._8,8._2),cx=4_'b',lx=.true.))
     call scalararg(scalar(4)(5.,6,(7._8,8._2),4_'b',.true.))
     !ERROR: Value in structure constructor of type 'CHARACTER(1)' is incompatible with component 'ix' of type 'INTEGER(4)'
     call scalararg(scalar(4)(ix='a'))
     !ERROR: Value in structure constructor of type 'LOGICAL(4)' is incompatible with component 'ix' of type 'INTEGER(4)'
     call scalararg(scalar(4)(ix=.false.))
     !ERROR: Rank-1 array value is not compatible with scalar component 'ix'
     call scalararg(scalar(4)(ix=[1]))
     !TODO more!
   end subroutine errors
 end module module1