[flang-commits] [flang] 9e7eef9 - [flang] Handle parameter-dependent types in PDT initializers
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Apr 15 16:20:49 PDT 2022
Author: Peter Klausler
Date: 2022-04-15T16:20:41-07:00
New Revision: 9e7eef9989d365214b2b62be630d0bc9d9e94968
URL: https://github.com/llvm/llvm-project/commit/9e7eef9989d365214b2b62be630d0bc9d9e94968
DIFF: https://github.com/llvm/llvm-project/commit/9e7eef9989d365214b2b62be630d0bc9d9e94968.diff
LOG: [flang] Handle parameter-dependent types in PDT initializers
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.
Differential Revision: https://reviews.llvm.org/D123728
Added:
flang/test/Semantics/modfile48.f90
Modified:
flang/include/flang/Common/indirection.h
flang/include/flang/Parser/unparse.h
flang/include/flang/Semantics/expression.h
flang/include/flang/Semantics/symbol.h
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/symbol.cpp
flang/lib/Semantics/type.cpp
flang/test/Semantics/init01.f90
flang/test/Semantics/structconst02.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Common/indirection.h b/flang/include/flang/Common/indirection.h
index a4ef615dc122e..0bb7cc540a3c2 100644
--- a/flang/include/flang/Common/indirection.h
+++ b/flang/include/flang/Common/indirection.h
@@ -154,11 +154,14 @@ template <typename A> class ForwardOwningPointer {
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;
}
diff --git a/flang/include/flang/Parser/unparse.h b/flang/include/flang/Parser/unparse.h
index cc79294b909d3..40094ecbc85e5 100644
--- a/flang/include/flang/Parser/unparse.h
+++ b/flang/include/flang/Parser/unparse.h
@@ -27,6 +27,7 @@ class ProcedureRef;
namespace Fortran::parser {
struct Program;
+struct Expr;
// A function called before each Statement is unparsed.
using preStatementType =
@@ -43,11 +44,19 @@ struct AnalyzedObjectsAsFortran {
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
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index fd649308d7d66..7c9e4ff4473e5 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -480,6 +480,12 @@ class ExprChecker {
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;
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index d4c0b37adb885..7074d53db4d03 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -24,6 +24,9 @@
namespace llvm {
class raw_ostream;
}
+namespace Fortran::parser {
+struct Expr;
+}
namespace Fortran::semantics {
@@ -190,6 +193,12 @@ class ObjectEntityDetails : public EntityDetails {
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_; }
@@ -211,6 +220,7 @@ class ObjectEntityDetails : public EntityDetails {
private:
MaybeExpr init_;
+ const parser::Expr *unanalyzedPDTComponentInit_{nullptr};
ArraySpec shape_;
ArraySpec coshape_;
const Symbol *commonBlock_{nullptr}; // common block this object is in
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 4a66d528f407c..f6b4ad2f19c6b 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2733,12 +2733,18 @@ void UnparseVisitor::Word(const char *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
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 93d60579ada7e..e276fbbd6cb17 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -693,10 +693,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
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()};
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 1148af802d07c..8d1b095a02c3e 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -12,6 +12,7 @@
#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"
@@ -45,7 +46,8 @@ struct ModHeader {
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 &);
@@ -399,7 +401,7 @@ void ModFileWriter::PutDECStructure(
}
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/
@@ -661,7 +663,7 @@ void ModFileWriter::PutObjectEntity(
symbol.attrs());
PutShape(os, details.shape(), '(', ')');
PutShape(os, details.coshape(), '[', ']');
- PutInit(os, symbol, details.init());
+ PutInit(os, symbol, details.init(), details.unanalyzedPDTComponentInit());
os << '\n';
}
@@ -715,13 +717,14 @@ void ModFileWriter::PutTypeParam(llvm::raw_ostream &os, const Symbol &symbol) {
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);
}
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 2e693f82220a9..283dffb019b3b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6599,14 +6599,13 @@ void DeclarationVisitor::NonPointerInitialization(
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));
+ // Save the expression for per-instantiation analysis.
+ details->set_unanalyzedPDTComponentInit(&expr.thing.value());
+ } else {
+ if (MaybeExpr folded{EvaluateNonPointerInitializer(
+ ultimate, expr, expr.thing.value().source)}) {
+ details->set_init(std::move(*folded));
}
- } else if (MaybeExpr folded{EvaluateNonPointerInitializer(
- ultimate, expr, expr.thing.value().source)}) {
- details->set_init(std::move(*folded));
}
}
}
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index cf24e28225c50..8119e385bacfe 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -380,6 +380,9 @@ llvm::raw_ostream &operator<<(
DumpList(os, "shape", x.shape());
DumpList(os, "coshape", x.coshape());
DumpExpr(os, "init", x.init_);
+ if (x.unanalyzedPDTComponentInit()) {
+ os << " (has unanalyzedPDTComponentInit)";
+ }
return os;
}
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 9c06cd327d0ee..f6888a7198e24 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -12,6 +12,7 @@
#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"
@@ -378,6 +379,31 @@ void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
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()))};
@@ -409,6 +435,18 @@ void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
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
diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90
index 7e962596dd263..fe48edeb7eeaa 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -46,7 +46,8 @@ subroutine dataobjects(j)
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
@@ -64,7 +65,7 @@ subroutine components
!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
@@ -80,8 +81,8 @@ subroutine components
!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
diff --git a/flang/test/Semantics/modfile48.f90 b/flang/test/Semantics/modfile48.f90
new file mode 100644
index 0000000000000..d3f20f08292e7
--- /dev/null
+++ b/flang/test/Semantics/modfile48.f90
@@ -0,0 +1,18 @@
+! 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
diff --git a/flang/test/Semantics/structconst02.f90 b/flang/test/Semantics/structconst02.f90
index e5ccc0f005df3..1eb714253f903 100644
--- a/flang/test/Semantics/structconst02.f90
+++ b/flang/test/Semantics/structconst02.f90
@@ -11,10 +11,10 @@ end function realfunc
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()
@@ -25,7 +25,11 @@ end function realfunc
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))
More information about the flang-commits
mailing list