From 9e855a6cb84a7c1f9f027474e9b881206df925e3 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Fri, 2 Dec 2022 07:19:49 -0800 Subject: [PATCH] [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 --- flang/include/flang/Evaluate/call.h | 1 + flang/include/flang/Evaluate/traverse.h | 6 +- flang/include/flang/Evaluate/variable.h | 7 +- flang/include/flang/Semantics/symbol.h | 4 + flang/include/flang/Semantics/type.h | 4 +- flang/lib/Evaluate/call.cpp | 4 + flang/lib/Evaluate/variable.cpp | 17 +++ flang/lib/Semantics/mod-file.cpp | 5 +- flang/lib/Semantics/resolve-names-utils.cpp | 186 ++++++++++++++++++++++++++++ flang/lib/Semantics/resolve-names-utils.h | 6 + flang/lib/Semantics/resolve-names.cpp | 23 ++-- flang/lib/Semantics/runtime-type-info.cpp | 2 +- flang/lib/Semantics/symbol.cpp | 3 + flang/lib/Semantics/type.cpp | 4 +- flang/test/Semantics/modproc01.f90 | 149 ++++++++++++++++++++++ 15 files changed, 396 insertions(+), 25 deletions(-) create mode 100644 flang/test/Semantics/modproc01.f90 diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 3a083ab..7698385 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 d7efa17..79cef79 100644 --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -53,7 +53,7 @@ public: Result operator()(const common::Indirection &x) const { return visitor_(x.value()); } - template Result operator()(const SymbolRef x) const { + template Result operator()(const SymbolRef x) const { return visitor_(*x); } template Result operator()(const std::unique_ptr &x) const { @@ -122,13 +122,13 @@ public: // 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 44abe79..9565826 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -80,6 +80,9 @@ public: 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 @@ public: const Symbol &GetLastSymbol() const; const Component &GetComponent() const { return std::get(u_); } Component &GetComponent() { return std::get(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 dcf3b6f..7034b0c 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -105,6 +105,10 @@ public: 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 16e2a22..c60dc9f 100644 --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -261,7 +261,7 @@ public: 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 @@ public: // 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 &, 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 2ff4c31..829af50 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(&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 dfde7c2..1749425 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 9a5a34f..e635669 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() && found->owner() != scope_; } else { diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp index 60ca695..b0c64ab 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 symbolMap; + std::map typeMap; +}; + +class SymbolMapper : public evaluate::AnyTraverse { +public: + using Base = evaluate::AnyTraverse; + 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(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()}) { + 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()}; + subp && subp->isInterface()) { + if (Symbol *newSymbol{scope_.CopySymbol(*interface)}) { + newSymbol->get().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()}; + auto &newDetails{newSymbol.get()}; + 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 d0986fd..5b537d8 100644 --- a/flang/lib/Semantics/resolve-names-utils.h +++ b/flang/lib/Semantics/resolve-names-utils.h @@ -145,5 +145,11 @@ private: } 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 a97fe49..beca842 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().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()}; - auto &newDetails{newSymbol.get()}; - 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().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 62cb264..45917bf 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 9c9fa37..fb30f6e 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()}; return use && use->symbol() == x.symbol(); }, + [&](const HostAssocDetails &) { + return this->has(); + }, [](const auto &) { return false; }, }, details); diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 442f5e3..4560c47 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 &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 0000000..c7d0578 --- /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 -- 2.7.4