[flang-commits] [flang] 9e855a6 - [flang] Map symbols in expressions when copying interface symbols
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Dec 5 07:34:32 PST 2022
Author: Peter Klausler
Date: 2022-12-05T07:33:57-08:00
New Revision: 9e855a6cb84a7c1f9f027474e9b881206df925e3
URL: https://github.com/llvm/llvm-project/commit/9e855a6cb84a7c1f9f027474e9b881206df925e3
DIFF: https://github.com/llvm/llvm-project/commit/9e855a6cb84a7c1f9f027474e9b881206df925e3.diff
LOG: [flang] Map symbols in expressions when copying interface symbols
Given a MODULE SUBROUTINE or MODULE FUNCTION interface followed
later by a corresponding separate module subprogram definition in a
MODULE PROCEDURE, the copies of the interface's dummy argument and
function result symbols that populate the initial scope of that
MODULE PROCEDURE need to have any symbol references in their types
or bounds adjusted to point to their new counterparts.
Differential Revision: https://reviews.llvm.org/D139200
Added:
flang/test/Semantics/modproc01.f90
Modified:
flang/include/flang/Evaluate/call.h
flang/include/flang/Evaluate/traverse.h
flang/include/flang/Evaluate/variable.h
flang/include/flang/Semantics/symbol.h
flang/include/flang/Semantics/type.h
flang/lib/Evaluate/call.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/lib/Semantics/resolve-names-utils.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/lib/Semantics/symbol.cpp
flang/lib/Semantics/type.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 3a083ab574ce1..76983853c169d 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -185,6 +185,7 @@ struct ProcedureDesignator {
// Exactly one of these will return a non-null pointer.
const SpecificIntrinsic *GetSpecificIntrinsic() const;
const Symbol *GetSymbol() const; // symbol or component symbol
+ const SymbolRef *UnwrapSymbolRef() const; // null if intrinsic or component
// For references to NOPASS components and bindings only.
// References to PASS components and bindings are represented
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index d7efa17f60bd0..79cef799c8b31 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -53,7 +53,7 @@ template <typename Visitor, typename Result> class Traverse {
Result operator()(const common::Indirection<A, C> &x) const {
return visitor_(x.value());
}
- template <typename A> Result operator()(const SymbolRef x) const {
+ template <typename _> Result operator()(const SymbolRef x) const {
return visitor_(*x);
}
template <typename A> Result operator()(const std::unique_ptr<A> &x) const {
@@ -122,13 +122,13 @@ template <typename Visitor, typename Result> class Traverse {
// Variables
Result operator()(const BaseObject &x) const { return visitor_(x.u); }
Result operator()(const Component &x) const {
- return Combine(x.base(), x.GetLastSymbol());
+ return Combine(x.base(), x.symbol());
}
Result operator()(const NamedEntity &x) const {
if (const Component * component{x.UnwrapComponent()}) {
return visitor_(*component);
} else {
- return visitor_(x.GetFirstSymbol());
+ return visitor_(DEREF(x.UnwrapSymbolRef()));
}
}
Result operator()(const TypeParamInquiry &x) const {
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index 44abe79e50bc9..9565826dbfaea 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -80,6 +80,9 @@ class Component {
const DataRef &base() const { return base_.value(); }
DataRef &base() { return base_.value(); }
+ const SymbolRef &symbol() const { return symbol_; }
+ SymbolRef &symbol() { return symbol_; }
+
int Rank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const { return symbol_; }
@@ -107,7 +110,9 @@ class NamedEntity {
const Symbol &GetLastSymbol() const;
const Component &GetComponent() const { return std::get<Component>(u_); }
Component &GetComponent() { return std::get<Component>(u_); }
- const Component *UnwrapComponent() const; // null if just a Symbol
+ const SymbolRef *UnwrapSymbolRef() const; // null if a Component
+ SymbolRef *UnwrapSymbolRef();
+ const Component *UnwrapComponent() const; // null if not a Component
Component *UnwrapComponent();
int Rank() const;
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index dcf3b6fb3db9f..7034b0cb52aa8 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -105,6 +105,10 @@ class SubprogramDetails : public WithBindName {
Symbol *moduleInterface() { return moduleInterface_; }
const Symbol *moduleInterface() const { return moduleInterface_; }
void set_moduleInterface(Symbol &);
+ void ReplaceResult(Symbol &result) {
+ CHECK(result_ != nullptr);
+ result_ = &result;
+ }
private:
bool isInterface_{false}; // true if this represents an interface-body
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 16e2a2293ba1f..c60dc9f5f6c84 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -261,7 +261,7 @@ class DerivedTypeSpec {
const Scope *scope() const { return scope_; }
void set_scope(const Scope &);
void ReplaceScope(const Scope &);
- RawParameters &rawParameters() { return rawParameters_; }
+ const RawParameters &rawParameters() const { return rawParameters_; }
const ParameterMapType ¶meters() const { return parameters_; }
bool MightBeParameterized() const;
@@ -272,7 +272,7 @@ class DerivedTypeSpec {
// The "raw" type parameter list is a simple transcription from the
// parameter list in the parse tree, built by calling AddRawParamValue().
// It can be used with forward-referenced derived types.
- void AddRawParamValue(const std::optional<parser::Keyword> &, ParamValue &&);
+ void AddRawParamValue(const parser::Keyword *, ParamValue &&);
// Checks the raw parameter list against the definition of a derived type.
// Converts the raw parameter list to a map, naming each actual parameter.
void CookParameters(evaluate::FoldingContext &);
diff --git a/flang/lib/Evaluate/call.cpp b/flang/lib/Evaluate/call.cpp
index 2ff4c317969e6..829af505b5f12 100644
--- a/flang/lib/Evaluate/call.cpp
+++ b/flang/lib/Evaluate/call.cpp
@@ -183,6 +183,10 @@ const Symbol *ProcedureDesignator::GetSymbol() const {
u);
}
+const SymbolRef *ProcedureDesignator::UnwrapSymbolRef() const {
+ return std::get_if<SymbolRef>(&u);
+}
+
std::string ProcedureDesignator::GetName() const {
return common::visit(
common::visitors{
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index dfde7c23efd74..1749425b6aecd 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -472,6 +472,23 @@ const Symbol &NamedEntity::GetLastSymbol() const {
u_);
}
+const SymbolRef *NamedEntity::UnwrapSymbolRef() const {
+ return common::visit(
+ common::visitors{
+ [](const SymbolRef &s) { return &s; },
+ [](const Component &) -> const SymbolRef * { return nullptr; },
+ },
+ u_);
+}
+
+SymbolRef *NamedEntity::UnwrapSymbolRef() {
+ return common::visit(common::visitors{
+ [](SymbolRef &s) { return &s; },
+ [](Component &) -> SymbolRef * { return nullptr; },
+ },
+ u_);
+}
+
const Component *NamedEntity::UnwrapComponent() const {
return common::visit(
common::visitors{
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 9a5a34fe4b931..e635669c238cd 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1256,11 +1256,14 @@ bool SubprogramSymbolCollector::NeedImport(
const SourceName &name, const Symbol &symbol) {
if (!isInterface_) {
return false;
+ } else if (IsSeparateModuleProcedureInterface(&symbol_)) {
+ return false; // IMPORT needed only for external and dummy procedure
+ // interfaces
} else if (&symbol == scope_.symbol()) {
return false;
} else if (symbol.owner().Contains(scope_)) {
return true;
- } else if (const Symbol * found{scope_.FindSymbol(name)}) {
+ } else if (const Symbol *found{scope_.FindSymbol(name)}) {
// detect import from ancestor of use-associated symbol
return found->has<UseDetails>() && found->owner() != scope_;
} else {
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 60ca695ea6ace..b0c64abd4c696 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -13,6 +13,7 @@
#include "flang/Common/indirection.h"
#include "flang/Evaluate/fold.h"
#include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
#include "flang/Evaluate/type.h"
#include "flang/Parser/char-block.h"
#include "flang/Parser/parse-tree.h"
@@ -742,4 +743,189 @@ bool EquivalenceSets::IsSequenceType(const DeclTypeSpec *type,
}
}
+// MapSubprogramToNewSymbols() relies on the following recursive symbol/scope
+// copying infrastructure to duplicate an interface's symbols and map all
+// of the symbol references in their contained expressions and interfaces
+// to the new symbols.
+
+struct SymbolAndTypeMappings {
+ std::map<const Symbol *, const Symbol *> symbolMap;
+ std::map<const DeclTypeSpec *, const DeclTypeSpec *> typeMap;
+};
+
+class SymbolMapper : public evaluate::AnyTraverse<SymbolMapper, bool> {
+public:
+ using Base = evaluate::AnyTraverse<SymbolMapper, bool>;
+ SymbolMapper(Scope &scope, SymbolAndTypeMappings &map)
+ : Base{*this}, scope_{scope}, map_{map} {}
+ using Base::operator();
+ bool operator()(const SymbolRef &ref) const {
+ if (const Symbol *mapped{MapSymbol(*ref)}) {
+ const_cast<SymbolRef &>(ref) = *mapped;
+ }
+ return false;
+ }
+ bool operator()(const Symbol &x) const {
+ if (MapSymbol(x)) {
+ DIE("SymbolMapper hit symbol outside SymbolRef");
+ }
+ return false;
+ }
+ void MapSymbolExprs(Symbol &);
+
+private:
+ void MapParamValue(ParamValue ¶m) const { (*this)(param.GetExplicit()); }
+ void MapBound(Bound &bound) const { (*this)(bound.GetExplicit()); }
+ void MapShapeSpec(ShapeSpec &spec) const {
+ MapBound(spec.lbound());
+ MapBound(spec.ubound());
+ }
+ const Symbol *MapSymbol(const Symbol &) const;
+ const Symbol *MapSymbol(const Symbol *) const;
+ const DeclTypeSpec *MapType(const DeclTypeSpec &);
+ const DeclTypeSpec *MapType(const DeclTypeSpec *);
+ const Symbol *MapInterface(const Symbol *);
+
+ Scope &scope_;
+ SymbolAndTypeMappings &map_;
+};
+
+void SymbolMapper::MapSymbolExprs(Symbol &symbol) {
+ if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+ if (const DeclTypeSpec *type{object->type()}) {
+ if (const DeclTypeSpec *newType{MapType(*type)}) {
+ object->ReplaceType(*newType);
+ }
+ }
+ }
+ common::visit(common::visitors{[&](ObjectEntityDetails &object) {
+ for (ShapeSpec &spec : object.shape()) {
+ MapShapeSpec(spec);
+ }
+ for (ShapeSpec &spec : object.coshape()) {
+ MapShapeSpec(spec);
+ }
+ },
+ [&](ProcEntityDetails &proc) {
+ if (const Symbol *mappedSymbol{
+ MapInterface(proc.interface().symbol())}) {
+ proc.interface().set_symbol(*mappedSymbol);
+ } else if (const DeclTypeSpec *mappedType{
+ MapType(proc.interface().type())}) {
+ proc.interface().set_type(*mappedType);
+ }
+ if (proc.init()) {
+ if (const Symbol *mapped{MapSymbol(*proc.init())}) {
+ proc.set_init(*mapped);
+ }
+ }
+ },
+ [&](const HostAssocDetails &hostAssoc) {
+ if (const Symbol *mapped{MapSymbol(hostAssoc.symbol())}) {
+ symbol.set_details(HostAssocDetails{*mapped});
+ }
+ },
+ [](const auto &) {}},
+ symbol.details());
+}
+
+const Symbol *SymbolMapper::MapSymbol(const Symbol &symbol) const {
+ if (auto iter{map_.symbolMap.find(&symbol)}; iter != map_.symbolMap.end()) {
+ return iter->second;
+ }
+ return nullptr;
+}
+
+const Symbol *SymbolMapper::MapSymbol(const Symbol *symbol) const {
+ return symbol ? MapSymbol(*symbol) : nullptr;
+}
+
+const DeclTypeSpec *SymbolMapper::MapType(const DeclTypeSpec &type) {
+ if (auto iter{map_.typeMap.find(&type)}; iter != map_.typeMap.end()) {
+ return iter->second;
+ }
+ const DeclTypeSpec *newType{nullptr};
+ if (type.category() == DeclTypeSpec::Category::Character) {
+ const CharacterTypeSpec &charType{type.characterTypeSpec()};
+ if (charType.length().GetExplicit()) {
+ ParamValue newLen{charType.length()};
+ (*this)(newLen.GetExplicit());
+ newType = &scope_.MakeCharacterType(
+ std::move(newLen), KindExpr{charType.kind()});
+ }
+ } else if (const DerivedTypeSpec *derived{type.AsDerived()}) {
+ if (!derived->parameters().empty()) {
+ DerivedTypeSpec newDerived{derived->name(), derived->typeSymbol()};
+ newDerived.CookParameters(scope_.context().foldingContext());
+ for (const auto &[paramName, paramValue] : derived->parameters()) {
+ ParamValue newParamValue{paramValue};
+ MapParamValue(newParamValue);
+ newDerived.AddParamValue(paramName, std::move(newParamValue));
+ }
+ // Scope::InstantiateDerivedTypes() instantiates it later.
+ newType = &scope_.MakeDerivedType(type.category(), std::move(newDerived));
+ }
+ }
+ if (newType) {
+ map_.typeMap[&type] = newType;
+ }
+ return newType;
+}
+
+const DeclTypeSpec *SymbolMapper::MapType(const DeclTypeSpec *type) {
+ return type ? MapType(*type) : nullptr;
+}
+
+const Symbol *SymbolMapper::MapInterface(const Symbol *interface) {
+ if (const Symbol *mapped{MapSymbol(interface)}) {
+ return mapped;
+ }
+ if (interface) {
+ if (&interface->owner() != &scope_) {
+ return interface;
+ } else if (const auto *subp{interface->detailsIf<SubprogramDetails>()};
+ subp && subp->isInterface()) {
+ if (Symbol *newSymbol{scope_.CopySymbol(*interface)}) {
+ newSymbol->get<SubprogramDetails>().set_isInterface(true);
+ map_.symbolMap[interface] = newSymbol;
+ Scope &newScope{scope_.MakeScope(Scope::Kind::Subprogram, newSymbol)};
+ MapSubprogramToNewSymbols(*interface, *newSymbol, newScope, &map_);
+ return newSymbol;
+ }
+ }
+ }
+ return nullptr;
+}
+
+void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
+ Scope &newScope, SymbolAndTypeMappings *mappings) {
+ SymbolAndTypeMappings newMappings;
+ if (!mappings) {
+ mappings = &newMappings;
+ }
+ mappings->symbolMap[&oldSymbol] = &newSymbol;
+ const auto &oldDetails{oldSymbol.get<SubprogramDetails>()};
+ auto &newDetails{newSymbol.get<SubprogramDetails>()};
+ for (const Symbol *dummyArg : oldDetails.dummyArgs()) {
+ if (!dummyArg) {
+ newDetails.add_alternateReturn();
+ } else if (Symbol *copy{newScope.CopySymbol(*dummyArg)}) {
+ newDetails.add_dummyArg(*copy);
+ mappings->symbolMap[dummyArg] = copy;
+ }
+ }
+ if (oldDetails.isFunction()) {
+ newScope.erase(newSymbol.name());
+ if (Symbol *copy{newScope.CopySymbol(oldDetails.result())}) {
+ newDetails.set_result(*copy);
+ mappings->symbolMap[&oldDetails.result()] = copy;
+ }
+ }
+ SymbolMapper mapper{newScope, *mappings};
+ for (auto &[_, ref] : newScope) {
+ mapper.MapSymbolExprs(*ref);
+ }
+ newScope.InstantiateDerivedTypes();
+}
+
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/resolve-names-utils.h b/flang/lib/Semantics/resolve-names-utils.h
index d0986fdfc139e..5b537d80e5f88 100644
--- a/flang/lib/Semantics/resolve-names-utils.h
+++ b/flang/lib/Semantics/resolve-names-utils.h
@@ -145,5 +145,11 @@ class EquivalenceSets {
} currObject_; // equivalence object currently being constructed
};
+// Duplicates a subprogram's dummy arguments and result, if any, and
+// maps all of the symbols in their expressions.
+struct SymbolAndTypeMappings;
+void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
+ Scope &newScope, SymbolAndTypeMappings * = nullptr);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_RESOLVE_NAMES_H_
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index a97fe49bdbcb9..beca842745f54 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3735,23 +3735,15 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
symbol->get<SubprogramDetails>().set_isInterface(false);
} else {
// Copy the interface into a new subprogram scope.
+ EraseSymbol(name);
Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
PushScope(Scope::Kind::Subprogram, &newSymbol);
- const auto &details{symbol->get<SubprogramDetails>()};
- auto &newDetails{newSymbol.get<SubprogramDetails>()};
- newDetails.set_moduleInterface(*symbol);
- for (const Symbol *dummyArg : details.dummyArgs()) {
- if (!dummyArg) {
- newDetails.add_alternateReturn();
- } else if (Symbol * copy{currScope().CopySymbol(*dummyArg)}) {
- newDetails.add_dummyArg(*copy);
- }
- }
- if (details.isFunction()) {
- currScope().erase(symbol->name());
- newDetails.set_result(*currScope().CopySymbol(details.result()));
- }
+ newSymbol.get<SubprogramDetails>().set_moduleInterface(*symbol);
newSymbol.attrs() |= symbol->attrs();
+ newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
+ ? Symbol::Flag::Subroutine
+ : Symbol::Flag::Function);
+ MapSubprogramToNewSymbols(*symbol, newSymbol, currScope());
}
return true;
}
@@ -4593,7 +4585,8 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
// DerivedTypeSpec::CookParameters().
ParamValue param{GetParamValue(value, common::TypeParamAttr::Kind)};
if (!param.isExplicit() || param.GetExplicit()) {
- spec->AddRawParamValue(optKeyword, std::move(param));
+ spec->AddRawParamValue(
+ common::GetPtrFromOptional(optKeyword), std::move(param));
}
}
// The DerivedTypeSpec *spec is used initially as a search key.
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 62cb264e353a0..45917bf35c4fc 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -387,7 +387,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
for (SymbolRef lenParam : *lenParameters) {
(void)lenParam;
derived.AddRawParamValue(
- std::nullopt, ParamValue::Deferred(common::TypeParamAttr::Len));
+ nullptr, ParamValue::Deferred(common::TypeParamAttr::Len));
}
derived.CookParameters(context_.foldingContext());
}
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 9c9fa37f7273f..fb30f6e4d687a 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -280,6 +280,9 @@ bool Symbol::CanReplaceDetails(const Details &details) const {
const auto *use{this->detailsIf<UseDetails>()};
return use && use->symbol() == x.symbol();
},
+ [&](const HostAssocDetails &) {
+ return this->has<HostAssocDetails>();
+ },
[](const auto &) { return false; },
},
details);
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 442f5e320f779..4560c47353835 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -37,9 +37,9 @@ void DerivedTypeSpec::ReplaceScope(const Scope &scope) {
}
void DerivedTypeSpec::AddRawParamValue(
- const std::optional<parser::Keyword> &keyword, ParamValue &&value) {
+ const parser::Keyword *keyword, ParamValue &&value) {
CHECK(parameters_.empty());
- rawParameters_.emplace_back(keyword ? &*keyword : nullptr, std::move(value));
+ rawParameters_.emplace_back(keyword, std::move(value));
}
void DerivedTypeSpec::CookParameters(evaluate::FoldingContext &foldingContext) {
diff --git a/flang/test/Semantics/modproc01.f90 b/flang/test/Semantics/modproc01.f90
new file mode 100644
index 0000000000000..c7d05783335e6
--- /dev/null
+++ b/flang/test/Semantics/modproc01.f90
@@ -0,0 +1,149 @@
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+module m
+ type pdt1(k1,l1)
+ integer, kind :: k1
+ integer, len :: l1
+ type(pdt2(k1,l1)), allocatable :: a1
+ end type pdt1
+ type pdt2(k2,l2)
+ integer, kind :: k2
+ integer, len :: l2
+ integer(k2) :: j2
+ type(pdt1(k2,l2)) :: a2(k2)
+ end type pdt2
+ interface
+ module function mf(n,str,x1) result(res)
+ integer, intent(in) :: n
+ character(n), intent(in) :: str
+ type(pdt1(1,n)), intent(in) :: x1
+ type(pdt2(2,n)) :: res
+ end function
+ module subroutine ms(f)
+ procedure(mf) :: f
+ end subroutine
+ end interface
+end module
+!CHECK: mf, MODULE, PUBLIC (Function): Subprogram isInterface result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1)
+!CHECK: pdt1, PUBLIC: DerivedType components: a1
+!CHECK: pdt2, PUBLIC: DerivedType components: j2,a2
+!CHECK: sm: Module (m)
+!CHECK: DerivedType scope: pdt1
+!CHECK: a1, ALLOCATABLE: ObjectEntity type: TYPE(pdt2(int(k1,kind=4),int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind
+!CHECK: l1: TypeParam type:INTEGER(4) Len
+!CHECK: DerivedType scope: pdt2
+!CHECK: a2: ObjectEntity type: TYPE(pdt1(k1=int(k2,kind=4),l1=int(l2,kind=4))) shape: 1_8:k2
+!CHECK: j2: ObjectEntity type: INTEGER(int(int(k2,kind=4),kind=8))
+!CHECK: k2: TypeParam type:INTEGER(4) Kind
+!CHECK: l2: TypeParam type:INTEGER(4) Len
+!CHECK: Subprogram scope: mf size=112 alignment=8
+!CHECK: mf (Function): HostAssoc
+!CHECK: n, INTENT(IN) size=4 offset=0: ObjectEntity dummy type: INTEGER(4)
+!CHECK: res size=40 offset=72: ObjectEntity funcResult type: TYPE(pdt2(k2=2_4,l2=n))
+!CHECK: str, INTENT(IN) size=24 offset=8: ObjectEntity dummy type: CHARACTER(n,1)
+!CHECK: x1, INTENT(IN) size=40 offset=32: ObjectEntity dummy type: TYPE(pdt1(k1=1_4,l1=n))
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=n)
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:n
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=1_4,l2=int(l1,kind=4))
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=int(l2,kind=4))) shape: 1_8:1_8
+!CHECK: j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=int(l2,kind=4))
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=n)
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK: j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:n
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=int(l2,kind=4))
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=int(l1,kind=4))
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK: j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+
+submodule(m) sm
+ contains
+ module procedure mf
+ print *, len(str), x1%k1, x1%l1, res%k2, res%l2
+ allocate(res%a2(1)%a1)
+ res%a2(1)%a1%j2 = 2
+ end procedure
+ module procedure ms
+! type(pdt2(2.3)) x
+! x = f(3, "abc", pdt1(1,3)())
+ end procedure
+end submodule
+!CHECK: Module scope: sm size=0 alignment=1
+!CHECK: mf, MODULE, PUBLIC (Function): Subprogram result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1) moduleInterface: mf, MODULE, PUBLIC (Function): Subprogram isInterface result:TYPE(pdt2(k2=2_4,l2=n)) res (INTEGER(4) n,CHARACTER(n,1) str,TYPE(pdt1(k1=1_4,l1=n)) x1)
+!CHECK: Subprogram scope: mf size=112 alignment=8
+!CHECK: len, INTRINSIC, PURE (Function): ProcEntity
+!CHECK: n, INTENT(IN) size=4 offset=0: ObjectEntity dummy type: INTEGER(4)
+!CHECK: res size=40 offset=72: ObjectEntity funcResult type: TYPE(pdt2(k2=2_4,l2=n))
+!CHECK: str, INTENT(IN) size=24 offset=8: ObjectEntity dummy type: CHARACTER(n,1)
+!CHECK: x1, INTENT(IN) size=40 offset=32: ObjectEntity dummy type: TYPE(pdt1(k1=1_4,l1=n))
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=n)
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK: j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:n
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=int(l2,kind=4))
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=2_4,l2=int(l1,kind=4))
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=int(l2,kind=4))) shape: 1_8:2_8
+!CHECK: j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=n)
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:n
+!CHECK: DerivedType scope: size=72 alignment=8 instantiation of pdt2(k2=1_4,l2=int(l1,kind=4))
+!CHECK: a2 size=64 offset=8: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=int(l2,kind=4))) shape: 1_8:1_8
+!CHECK: j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:int(l1,kind=4)
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=int(l2,kind=4))
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=int(l1,kind=4)))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:int(l2,kind=4)
+
+program test
+ use m
+ type(pdt2(2,3)) x
+ x = mf(3, "abc", pdt1(1,3)())
+! call ms(mf)
+end program
+!CHECK: MainProgram scope: test size=88 alignment=8
+!CHECK: mf, MODULE (Function): Use from mf in m
+!CHECK: pdt1: Use from pdt1 in m
+!CHECK: pdt2: Use from pdt2 in m
+!CHECK: x size=88 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=3_4))
+!CHECK: DerivedType scope: size=88 alignment=8 instantiation of pdt2(k2=2_4,l2=3_4)
+!CHECK: a2 size=80 offset=8: ObjectEntity type: TYPE(pdt1(k1=2_4,l1=3_4)) shape: 1_8:2_8
+!CHECK: j2 size=2 offset=0: ObjectEntity type: INTEGER(2)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=2_4,l1=3_4)
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=2_4,l2=3_4))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:2_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=3_4)
+!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=3_4))
+!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l1: TypeParam type:INTEGER(4) Len init:3_4
+!CHECK: DerivedType scope: size=1 alignment=1 instantiation of pdt2(k2=1_4,l2=3_4)
+!CHECK: a2: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=3_4)) shape: 1_8:1_8
+!CHECK: j2 size=1 offset=0: ObjectEntity type: INTEGER(1)
+!CHECK: k2: TypeParam type:INTEGER(4) Kind init:1_4
+!CHECK: l2: TypeParam type:INTEGER(4) Len init:3_4
More information about the flang-commits
mailing list