diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -185,6 +185,7 @@ // 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 --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -53,7 +53,7 @@ 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 @@ // 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 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -80,6 +80,9 @@ 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 @@ 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 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -105,6 +105,10 @@ 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 --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -261,7 +261,7 @@ 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 @@ // 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 --- a/flang/lib/Evaluate/call.cpp +++ b/flang/lib/Evaluate/call.cpp @@ -183,6 +183,10 @@ 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 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -472,6 +472,23 @@ 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 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -1256,11 +1256,14 @@ 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.h b/flang/lib/Semantics/resolve-names-utils.h --- a/flang/lib/Semantics/resolve-names-utils.h +++ b/flang/lib/Semantics/resolve-names-utils.h @@ -145,5 +145,11 @@ } 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-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- 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 @@ } } +// 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.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3735,23 +3735,15 @@ 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 @@ // 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 --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -387,7 +387,7 @@ 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 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -280,6 +280,9 @@ 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 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -37,9 +37,9 @@ } 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 --- /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