[flang-commits] [flang] 0c19057 - [flang] Make generic resolution conform to 15.5.5.2 w/r/t host association
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sat May 28 10:06:21 PDT 2022
Author: Peter Klausler
Date: 2022-05-28T09:33:53-07:00
New Revision: 0c190575ebfc81e117d95e2eca25789610192125
URL: https://github.com/llvm/llvm-project/commit/0c190575ebfc81e117d95e2eca25789610192125
DIFF: https://github.com/llvm/llvm-project/commit/0c190575ebfc81e117d95e2eca25789610192125.diff
LOG: [flang] Make generic resolution conform to 15.5.5.2 w/r/t host association
When two or more generic interfaces are available by declaration or
by USE association at different scoping levels, we need to search
the outer generic interfaces as well as the inner ones, but only after
the inner ones have failed to produce a specific procedure that matches
a given set of actual arguments. This means that it is possible for
a specific procedure of a generic interface of an inner scope to override
a conflicting specific procedure of a generic interface of an outer
scope.
Also cope with forward references to derived types when a generic
interface is also in scope.
Fixes LLVM bug https://github.com/llvm/llvm-project/issues/55240 and
LLVM bug https://github.com/llvm/llvm-project/issues/55300.
Differential Revision: https://reviews.llvm.org/D126587
Added:
flang/test/Semantics/generic01.f90
Modified:
flang/include/flang/Semantics/expression.h
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/resolve22.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index e6a88ec6f16ea..6c0d385a266bc 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -336,7 +336,7 @@ class ExpressionAnalyzer {
};
std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
- const parser::ProcComponentRef &, ActualArguments &&);
+ const parser::ProcComponentRef &, ActualArguments &&, bool isSubroutine);
std::optional<characteristics::Procedure> CheckCall(
parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
using AdjustActuals =
@@ -344,7 +344,7 @@ class ExpressionAnalyzer {
bool ResolveForward(const Symbol &);
std::pair<const Symbol *, bool /* failure due to NULL() actuals */>
ResolveGeneric(const Symbol &, const ActualArguments &, const AdjustActuals &,
- bool mightBeStructureConstructor = false);
+ bool isSubroutine, bool mightBeStructureConstructor = false);
void EmitGenericResolutionError(const Symbol &, bool dueToNullActuals);
const Symbol &AccessSpecific(
const Symbol &originalGeneric, const Symbol &specific);
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 27c9f36727d91..58e789ba85ab7 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -614,5 +614,10 @@ bool HasDefinedIo(
const Symbol *FindUnsafeIoDirectComponent(
GenericKind::DefinedIo, const DerivedTypeSpec &, const Scope * = nullptr);
+// Some intrinsic operators have more than one name (e.g. `operator(.eq.)` and
+// `operator(==)`). GetAllNames() returns them all, including symbolName.
+std::forward_list<std::string> GetAllNames(
+ const SemanticsContext &, const SourceName &);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TOOLS_H_
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index be295408279bc..b2330db5ef5d6 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -9,6 +9,7 @@
#include "flang/Semantics/expression.h"
#include "check-call.h"
#include "pointer-assignment.h"
+#include "resolve-names-utils.h"
#include "resolve-names.h"
#include "flang/Common/Fortran.h"
#include "flang/Common/idioms.h"
@@ -1911,8 +1912,8 @@ static const Symbol *GetBindingResolution(
}
auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
- const parser::ProcComponentRef &pcr, ActualArguments &&arguments)
- -> std::optional<CalleeAndArguments> {
+ const parser::ProcComponentRef &pcr, ActualArguments &&arguments,
+ bool isSubroutine) -> std::optional<CalleeAndArguments> {
const parser::StructureComponent &sc{pcr.v.thing};
if (MaybeExpr base{Analyze(sc.base)}) {
if (const Symbol * sym{sc.component.symbol}) {
@@ -1935,7 +1936,7 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
}
return true;
}};
- auto pair{ResolveGeneric(*sym, arguments, adjustment)};
+ auto pair{ResolveGeneric(*sym, arguments, adjustment, isSubroutine)};
sym = pair.first;
if (sym) {
// re-resolve the name to the specific binding
@@ -2060,67 +2061,94 @@ bool ExpressionAnalyzer::ResolveForward(const Symbol &symbol) {
// adjustActuals is called on procedure bindings to handle pass arg.
std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
const Symbol &symbol, const ActualArguments &actuals,
- const AdjustActuals &adjustActuals, bool mightBeStructureConstructor) {
+ const AdjustActuals &adjustActuals, bool isSubroutine,
+ bool mightBeStructureConstructor) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const Symbol *nonElemental{nullptr}; // matching non-elemental specific
- const auto &details{symbol.GetUltimate().get<semantics::GenericDetails>()};
- bool anyBareNullActual{
- std::find_if(actuals.begin(), actuals.end(), [](auto iter) {
- return IsBareNullPointer(iter->UnwrapExpr());
- }) != actuals.end()};
- for (const Symbol &specific : details.specificProcs()) {
- if (!ResolveForward(specific)) {
- continue;
- }
- if (std::optional<characteristics::Procedure> procedure{
- characteristics::Procedure::Characterize(
- ProcedureDesignator{specific}, context_.foldingContext())}) {
- ActualArguments localActuals{actuals};
- if (specific.has<semantics::ProcBindingDetails>()) {
- if (!adjustActuals.value()(specific, localActuals)) {
- continue;
- }
- }
- if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
- GetFoldingContext(), false /* no integer conversions */) &&
- CheckCompatibleArguments(*procedure, localActuals)) {
- if ((procedure->IsElemental() && elemental) ||
- (!procedure->IsElemental() && nonElemental)) {
- // 16.9.144(6): a bare NULL() is not allowed as an actual
- // argument to a generic procedure if the specific procedure
- // cannot be unambiguously distinguished
- return {nullptr, true /* due to NULL actuals */};
+ const Symbol &ultimate{symbol.GetUltimate()};
+ // Check for a match with an explicit INTRINSIC
+ if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
+ parser::Messages buffer;
+ auto restorer{foldingContext_.messages().SetMessages(buffer)};
+ ActualArguments localActuals{actuals};
+ if (context_.intrinsics().Probe(
+ CallCharacteristics{ultimate.name().ToString(), isSubroutine},
+ localActuals, foldingContext_) &&
+ !buffer.AnyFatalError()) {
+ return {&ultimate, false};
+ }
+ }
+ if (const auto *details{ultimate.detailsIf<semantics::GenericDetails>()}) {
+ bool anyBareNullActual{
+ std::find_if(actuals.begin(), actuals.end(), [](auto iter) {
+ return IsBareNullPointer(iter->UnwrapExpr());
+ }) != actuals.end()};
+ for (const Symbol &specific : details->specificProcs()) {
+ if (!ResolveForward(specific)) {
+ continue;
+ }
+ if (std::optional<characteristics::Procedure> procedure{
+ characteristics::Procedure::Characterize(
+ ProcedureDesignator{specific}, context_.foldingContext())}) {
+ ActualArguments localActuals{actuals};
+ if (specific.has<semantics::ProcBindingDetails>()) {
+ if (!adjustActuals.value()(specific, localActuals)) {
+ continue;
+ }
}
- if (!procedure->IsElemental()) {
- // takes priority over elemental match
- nonElemental = &specific;
- if (!anyBareNullActual) {
- break; // unambiguous case
+ if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
+ GetFoldingContext(), false /* no integer conversions */) &&
+ CheckCompatibleArguments(*procedure, localActuals)) {
+ if ((procedure->IsElemental() && elemental) ||
+ (!procedure->IsElemental() && nonElemental)) {
+ // 16.9.144(6): a bare NULL() is not allowed as an actual
+ // argument to a generic procedure if the specific procedure
+ // cannot be unambiguously distinguished
+ return {nullptr, true /* due to NULL actuals */};
+ }
+ if (!procedure->IsElemental()) {
+ // takes priority over elemental match
+ nonElemental = &specific;
+ if (!anyBareNullActual) {
+ break; // unambiguous case
+ }
+ } else {
+ elemental = &specific;
}
- } else {
- elemental = &specific;
}
}
}
- }
- if (nonElemental) {
- return {&AccessSpecific(symbol, *nonElemental), false};
- } else if (elemental) {
- return {&AccessSpecific(symbol, *elemental), false};
- }
- // Check parent derived type
- if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
- if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
- if (extended->GetUltimate().has<semantics::GenericDetails>()) {
- auto pair{ResolveGeneric(*extended, actuals, adjustActuals, false)};
+ if (nonElemental) {
+ return {&AccessSpecific(symbol, *nonElemental), false};
+ } else if (elemental) {
+ return {&AccessSpecific(symbol, *elemental), false};
+ }
+ // Check parent derived type
+ if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
+ if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
+ auto pair{ResolveGeneric(
+ *extended, actuals, adjustActuals, isSubroutine, false)};
if (pair.first) {
return pair;
}
}
}
+ if (mightBeStructureConstructor && details->derivedType()) {
+ return {details->derivedType(), false};
+ }
}
- if (mightBeStructureConstructor && details.derivedType()) {
- return {details.derivedType(), false};
+ // Check for generic or explicit INTRINSIC of the same name in outer scopes.
+ // See 15.5.5.2 for details.
+ if (!symbol.owner().IsGlobal() && !symbol.owner().IsDerivedType()) {
+ for (const std::string &n : GetAllNames(context_, symbol.name())) {
+ if (const Symbol * outer{symbol.owner().parent().FindSymbol(n)}) {
+ auto pair{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
+ mightBeStructureConstructor)};
+ if (pair.first) {
+ return pair;
+ }
+ }
+ }
}
return {nullptr, false};
}
@@ -2179,7 +2207,8 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(
isSubroutine, mightBeStructureConstructor);
},
[&](const parser::ProcComponentRef &pcr) {
- return AnalyzeProcedureComponentRef(pcr, std::move(arguments));
+ return AnalyzeProcedureComponentRef(
+ pcr, std::move(arguments), isSubroutine);
},
},
pd.u);
@@ -2196,28 +2225,26 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
CheckForBadRecursion(name.source, ultimate);
bool dueToNullActual{false};
bool isGenericInterface{ultimate.has<semantics::GenericDetails>()};
+ bool isExplicitIntrinsic{ultimate.attrs().test(semantics::Attr::INTRINSIC)};
const Symbol *resolution{nullptr};
- if (isGenericInterface) {
+ if (isGenericInterface || isExplicitIntrinsic) {
ExpressionAnalyzer::AdjustActuals noAdjustment;
- auto pair{ResolveGeneric(
- *symbol, arguments, noAdjustment, mightBeStructureConstructor)};
+ auto pair{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
+ mightBeStructureConstructor)};
resolution = pair.first;
dueToNullActual = pair.second;
if (resolution) {
// re-resolve name to the specific procedure
name.symbol = const_cast<Symbol *>(resolution);
}
+ } else {
+ resolution = symbol;
}
- if (!resolution) {
+ if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
// Not generic, or no resolution; may be intrinsic
- bool isIntrinsic{symbol->attrs().test(semantics::Attr::INTRINSIC)};
- if (!isIntrinsic && !isGenericInterface) {
- resolution = symbol;
- } else if (std::optional<SpecificCall> specificCall{
- context_.intrinsics().Probe(
- CallCharacteristics{
- ultimate.name().ToString(), isSubroutine},
- arguments, GetFoldingContext())}) {
+ if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
+ CallCharacteristics{ultimate.name().ToString(), isSubroutine},
+ arguments, GetFoldingContext())}) {
CheckBadExplicitType(*specificCall, *symbol);
return CalleeAndArguments{
ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
@@ -3507,7 +3534,7 @@ std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc() {
const auto &scope{context_.context().FindScope(source_)};
if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
ExpressionAnalyzer::AdjustActuals noAdjustment;
- auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)};
+ auto pair{context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true)};
if (pair.first) {
proc = pair.first;
} else {
@@ -3615,7 +3642,7 @@ const Symbol *ArgumentAnalyzer::FindBoundOp(
[&](const Symbol &proc, ActualArguments &) {
return passIndex == GetPassIndex(proc);
}};
- auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment)};
+ auto pair{context_.ResolveGeneric(*symbol, actuals_, adjustment, false)};
if (!pair.first) {
context_.EmitGenericResolutionError(*symbol, pair.second);
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f03d3fa24b990..4c34392ecdc84 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -593,6 +593,10 @@ class ScopeHandler : public ImplicitRulesVisitor {
derivedType =
&currScope().MakeSymbol(name, attrs, std::move(details));
d->set_derivedType(*derivedType);
+ } else if (derivedType->CanReplaceDetails(details)) {
+ // was forward-referenced
+ derivedType->attrs() |= attrs;
+ derivedType->set_details(std::move(details));
} else {
SayAlreadyDeclared(name, *derivedType);
}
@@ -4048,11 +4052,13 @@ bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
HandleAttributeStmt(Attr::INTRINSIC, x.v);
for (const auto &name : x.v) {
+ if (!IsIntrinsic(name.source, std::nullopt)) {
+ Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
+ }
auto &symbol{DEREF(FindSymbol(name))};
if (symbol.has<GenericDetails>()) {
// Generic interface is extending intrinsic; ok
- } else if (!symbol.has<HostAssocDetails>() &&
- !ConvertToProcEntity(symbol)) {
+ } else if (!ConvertToProcEntity(symbol)) {
SayWithDecl(
name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
} else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
@@ -4096,25 +4102,6 @@ bool DeclarationVisitor::HandleAttributeStmt(
}
Symbol &DeclarationVisitor::HandleAttributeStmt(
Attr attr, const parser::Name &name) {
- if (attr == Attr::INTRINSIC) {
- if (!IsIntrinsic(name.source, std::nullopt)) {
- Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
- } else if (currScope().kind() == Scope::Kind::Subprogram ||
- currScope().kind() == Scope::Kind::Block) {
- if (auto *symbol{FindSymbol(name)}) {
- if (symbol->GetUltimate().has<GenericDetails>() &&
- symbol->owner() != currScope()) {
- // Declaring a name INTRINSIC when there is a generic
- // interface of the same name in the host scope.
- // Host-associate the generic and mark it INTRINSIC
- // rather than completely overriding the generic.
- symbol = &MakeHostAssocSymbol(name, *symbol);
- symbol->attrs().set(Attr::INTRINSIC);
- return *symbol;
- }
- }
- }
- }
auto *symbol{FindInScope(name)};
if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
// these can be set on a symbol that is host-assoc or use-assoc
@@ -5626,13 +5613,28 @@ void DeclarationVisitor::SetType(
std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
const parser::Name &name) {
- Symbol *symbol{FindSymbol(NonDerivedTypeScope(), name)};
- if (!symbol || symbol->has<UnknownDetails>()) {
+ Scope &outer{NonDerivedTypeScope()};
+ Symbol *symbol{FindSymbol(outer, name)};
+ Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr};
+ auto *generic{ultimate ? ultimate->detailsIf<GenericDetails>() : nullptr};
+ if (generic) {
+ if (Symbol * genDT{generic->derivedType()}) {
+ symbol = genDT;
+ generic = nullptr;
+ }
+ }
+ if (!symbol || symbol->has<UnknownDetails>() ||
+ (generic && &ultimate->owner() == &outer)) {
if (allowForwardReferenceToDerivedType()) {
if (!symbol) {
- symbol = &MakeSymbol(InclusiveScope(), name.source, Attrs{});
+ symbol = &MakeSymbol(outer, name.source, Attrs{});
Resolve(name, *symbol);
- };
+ } else if (generic) {
+ // forward ref to type with later homonymous generic
+ symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{});
+ generic->set_derivedType(*symbol);
+ name.symbol = symbol;
+ }
DerivedTypeDetails details;
details.set_isForwardReferenced(true);
symbol->set_details(std::move(details));
@@ -5645,11 +5647,6 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
return std::nullopt;
}
symbol = &symbol->GetUltimate();
- if (auto *details{symbol->detailsIf<GenericDetails>()}) {
- if (details->derivedType()) {
- symbol = &details->derivedType()->GetUltimate();
- }
- }
if (symbol->has<DerivedTypeDetails>()) {
return DerivedTypeSpec{name.source, *symbol};
} else {
@@ -7056,39 +7053,37 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
Symbol *existing{nullptr};
// Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
for (const std::string &n : GetAllNames(context(), symbolName)) {
- existing = currScope().FindSymbol(n);
- if (existing) {
+ if (auto iter{currScope().find(n)}; iter != currScope().end()) {
+ existing = &*iter->second;
break;
}
}
if (existing) {
Symbol &ultimate{existing->GetUltimate()};
if (const auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
- if (&ultimate.owner() != &currScope()) {
- // Create a local copy of a host or use associated generic so that
+ if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
+ // Create a local copy of a use associated generic so that
// it can be locally extended without corrupting the original.
genericDetails.CopyFrom(*existingGeneric);
- if (const auto *use{existing->detailsIf<UseDetails>()}) {
- AddGenericUse(genericDetails, existing->name(), use->symbol());
- EraseSymbol(*existing);
- }
- existing = &MakeSymbol(symbolName, Attrs{}, std::move(genericDetails));
- }
- info.Resolve(existing);
- return;
- }
- if (&existing->owner() == &currScope()) {
- if (ultimate.has<SubprogramDetails>() ||
- ultimate.has<SubprogramNameDetails>()) {
- genericDetails.set_specific(ultimate);
- } else if (ultimate.has<DerivedTypeDetails>()) {
- genericDetails.set_derivedType(ultimate);
- } else {
- SayAlreadyDeclared(symbolName, *existing);
+ AddGenericUse(genericDetails, existing->name(), existingUse->symbol());
+ } else if (existing == &ultimate) {
+ // Extending an extant generic in the same scope
+ info.Resolve(existing);
return;
+ } else {
+ // Host association of a generic is handled in ResolveGeneric()
+ CHECK(existing->has<HostAssocDetails>());
}
- EraseSymbol(*existing);
+ } else if (ultimate.has<SubprogramDetails>() ||
+ ultimate.has<SubprogramNameDetails>()) {
+ genericDetails.set_specific(ultimate);
+ } else if (ultimate.has<DerivedTypeDetails>()) {
+ genericDetails.set_derivedType(ultimate);
+ } else {
+ SayAlreadyDeclared(symbolName, *existing);
+ return;
}
+ EraseSymbol(*existing);
}
info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
}
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 807c0152eb9a1..848bf2dca32a8 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -668,7 +668,7 @@ bool HasImpureFinal(const DerivedTypeSpec &derived) {
derived.typeSymbol().detailsIf<DerivedTypeDetails>()}) {
const auto &finals{details->finals()};
return std::any_of(finals.begin(), finals.end(),
- [](const auto &x) { return !x.second->attrs().test(Attr::PURE); });
+ [](const auto &x) { return !IsPureProcedure(*x.second); });
} else {
return false;
}
diff --git a/flang/test/Semantics/generic01.f90 b/flang/test/Semantics/generic01.f90
new file mode 100644
index 0000000000000..21132f92d090a
--- /dev/null
+++ b/flang/test/Semantics/generic01.f90
@@ -0,0 +1,84 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! Tests rules of 15.5.5.2 for generics and explicit intrinsics
+! competing at various scoping levels.
+module m1
+ private
+ public abs
+ interface abs
+ module procedure :: abs_int_redef, abs_noargs
+ end interface
+contains
+ integer function abs_int_redef(j)
+ integer, intent(in) :: j
+ abs_int_redef = j
+ end function
+ integer function abs_noargs()
+ abs_noargs = 0
+ end function
+end module
+
+module m2
+ private
+ public abs
+ interface abs
+ module procedure abs_real_redef
+ end interface
+contains
+ real function abs_real_redef(x)
+ real, intent(in) :: x
+ abs_real_redef = x
+ end function
+end module
+
+module m3
+ use m1, only: abs
+ implicit none
+contains
+ subroutine test1
+ use m2, only: abs
+ !CHECK: abs_int_redef(
+ print *, abs(1)
+ !CHECK: abs_real_redef(
+ print *, abs(1.)
+ !CHECK: 1.41421353816986083984375_4
+ print *, abs((1,1))
+ !CHECK: abs_noargs(
+ print *, abs()
+ end subroutine
+ subroutine test2
+ intrinsic abs ! override some of module's use of m1
+ block
+ use m2, only: abs
+ !CHECK: 1_4
+ print *, abs(1)
+ !CHECK: abs_real_redef(
+ print *, abs(1.)
+ !CHECK: 1.41421353816986083984375_4
+ print *, abs((1,1))
+ !CHECK: abs_noargs(
+ print *, abs()
+ end block
+ end subroutine
+ subroutine test3
+ interface abs
+ module procedure abs_int_redef2 ! override module's use of m1
+ end interface
+ !CHECK: abs_int_redef2(
+ print *, abs(1)
+ !CHECK: 1._4
+ print *, abs(1.)
+ !CHECK: 1.41421353816986083984375_4
+ print *, abs((1,1))
+ !CHECK: abs_noargs(
+ print *, abs()
+ block
+ use m1, only: abs ! override the override
+ !CHECK: abs_int_redef(
+ print *, abs(1)
+ end block
+ end subroutine
+ integer function abs_int_redef2(j)
+ integer, intent(in) :: j
+ abs_int_redef2 = j
+ end function
+end module
diff --git a/flang/test/Semantics/resolve22.f90 b/flang/test/Semantics/resolve22.f90
index 6f2d00958d372..8009a32a0f0d5 100644
--- a/flang/test/Semantics/resolve22.f90
+++ b/flang/test/Semantics/resolve22.f90
@@ -30,3 +30,18 @@ subroutine s3
type(t) :: x
x = t()
end subroutine
+
+module m4
+ type t1
+ class(t2), pointer :: p => null()
+ end type
+ type t2
+ end type
+ interface t2
+ procedure ctor
+ end interface
+ contains
+ function ctor()
+ type(t2) ctor
+ end function
+end module
More information about the flang-commits
mailing list