caio/clang-p2996
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[flang] Acknowledge non-enforcement of C7108 (#139169)

Browse Source 
Fortran 2023 constraint C7108 prohibits the use of a structure
constructor in a way that is ambiguous with a generic function reference
(intrinsic or user-defined). Sadly, no Fortran compiler implements this
constraint, and the common portable interpretation seems to be the
generic resolution, not the structure constructor.

Restructure the processing of structure constructors in expression
analysis so that it can be driven both from the parse tree as well as
from generic resolution, and then use it to detect ambigous structure
constructor / generic function cases, so that a portability warning can
be issued. And document this as a new intentional violation of the
standard in Extensions.md.

Fixes https://github.com/llvm/llvm-project/issues/138807.
This commit is contained in:
Peter Klausler
2025-05-13 07:48:30 -07:00
committed by GitHub
parent 2ca2e1c9d5
commit e75fda107d
10 changed files with 343 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
flang/docs/Extensions.md
View File

@@ -159,6 +159,11 @@ end
to be constant will generate a compilation error. `ieee_support_standard`
depends in part on `ieee_support_halting`, so this also applies to
`ieee_support_standard` calls.
* F'2023 constraint C7108 prohibits the use of a structure constructor
that could also be interpreted as a generic function reference.
No other Fortran compiler enforces C7108 (to our knowledge);
they all resolve the ambiguity by interpreting the call as a function
reference. We do the same, with a portability warning.
## Extensions, deletions, and legacy features supported by default

13
flang/include/flang/Semantics/expression.h
View File

@@ -394,6 +394,19 @@ private:
MaybeExpr AnalyzeComplex(MaybeExpr &&re, MaybeExpr &&im, const char *what);
std::optional<Chevrons> AnalyzeChevrons(const parser::CallStmt &);
// CheckStructureConstructor() is used for parsed structure constructors
// as well as for generic function references.
struct ComponentSpec {
ComponentSpec() = default;
ComponentSpec(ComponentSpec &&) = default;
parser::CharBlock source, exprSource;
bool hasKeyword{false};
const Symbol *keywordSymbol{nullptr};
MaybeExpr expr;
};
MaybeExpr CheckStructureConstructor(parser::CharBlock typeName,
const semantics::DerivedTypeSpec &, std::list<ComponentSpec> &&);
MaybeExpr IterativelyAnalyzeSubexpressions(const parser::Expr &);
semantics::SemanticsContext &context_;

3
flang/include/flang/Support/Fortran-features.h
View File

@@ -54,7 +54,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank,
IgnoreIrrelevantAttributes, Unsigned, ContiguousOkForSeqAssociation)
IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
ContiguousOkForSeqAssociation)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

460
flang/lib/Semantics/expression.cpp
View File

@@ -2069,23 +2069,9 @@ static MaybeExpr ImplicitConvertTo(const semantics::Symbol &sym,
return std::nullopt;
}
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::StructureConstructor &structure) {
auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
parser::Name structureType{std::get<parser::Name>(parsedType.t)};
parser::CharBlock &typeName{structureType.source};
if (semantics::Symbol *typeSymbol{structureType.symbol}) {
if (typeSymbol->has<semantics::DerivedTypeDetails>()) {
semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()};
if (!CheckIsValidForwardReference(dtSpec)) {
return std::nullopt;
}
}
}
if (!parsedType.derivedTypeSpec) {
return std::nullopt;
}
const auto &spec{*parsedType.derivedTypeSpec};
MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
parser::CharBlock typeName, const semantics::DerivedTypeSpec &spec,
std::list<ComponentSpec> &&componentSpecs) {
const Symbol &typeSymbol{spec.typeSymbol()};
if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
return std::nullopt; // error recovery
@@ -2096,10 +2082,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(
const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796
AttachDeclaration(Say(typeName,
"ABSTRACT derived type '%s' may not be used in a "
"structure constructor"_err_en_US,
typeName),
AttachDeclaration(
Say(typeName,
"ABSTRACT derived type '%s' may not be used in a structure constructor"_err_en_US,
typeName),
typeSymbol); // C7114
}
@@ -2129,22 +2115,19 @@ MaybeExpr ExpressionAnalyzer::Analyze(
bool checkConflicts{true}; // until we hit one
auto &messages{GetContextualMessages()};
// NULL() can be a valid component
auto restorer{AllowNullPointer()};
for (const auto &component :
std::get<std::list<parser::ComponentSpec>>(structure.t)) {
const parser::Expr &expr{
std::get<parser::ComponentDataSource>(component.t).v.value()};
parser::CharBlock source{expr.source};
for (ComponentSpec &componentSpec : componentSpecs) {
parser::CharBlock source{componentSpec.source};
parser::CharBlock exprSource{componentSpec.exprSource};
auto restorer{messages.SetLocation(source)};
const Symbol *symbol{nullptr};
MaybeExpr value{Analyze(expr)};
const Symbol *symbol{componentSpec.keywordSymbol};
MaybeExpr &maybeValue{componentSpec.expr};
if (!maybeValue.has_value()) {
return std::nullopt;
}
Expr<SomeType> &value{*maybeValue};
std::optional<DynamicType> valueType{DynamicType::From(value)};
if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
if (componentSpec.hasKeyword) {
anyKeyword = true;
source = kw->v.source;
symbol = kw->v.symbol;
if (!symbol) {
// Skip overridden inaccessible parent components in favor of
// their later overrides.
@@ -2196,9 +2179,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
}
if (symbol) {
const semantics::Scope &innermost{context_.FindScope(expr.source)};
const semantics::Scope &innermost{context_.FindScope(exprSource)};
if (auto msg{CheckAccessibleSymbol(innermost, *symbol)}) {
Say(expr.source, std::move(*msg));
Say(exprSource, std::move(*msg));
}
if (checkConflicts) {
auto componentIter{
@@ -2206,8 +2189,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(
if (unavailable.find(symbol->name()) != unavailable.cend()) {
// C797, C798
Say(source,
"Component '%s' conflicts with another component earlier in "
"this structure constructor"_err_en_US,
"Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US,
symbol->name());
} else if (symbol->test(Symbol::Flag::ParentComp)) {
// Make earlier components unavailable once a whole parent appears.
@@ -2225,143 +2207,136 @@ MaybeExpr ExpressionAnalyzer::Analyze(
}
}
unavailable.insert(symbol->name());
if (value) {
if (symbol->has<semantics::TypeParamDetails>()) {
Say(expr.source,
"Type parameter '%s' may not appear as a component of a structure constructor"_err_en_US,
symbol->name());
}
if (!(symbol->has<semantics::ProcEntityDetails>() ||
symbol->has<semantics::ObjectEntityDetails>())) {
continue; // recovery
}
if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
semantics::CheckStructConstructorPointerComponent(
context_, *symbol, *value, innermost);
result.Add(*symbol, Fold(std::move(*value)));
continue;
}
if (IsNullPointer(&*value)) {
if (IsAllocatable(*symbol)) {
if (IsBareNullPointer(&*value)) {
// NULL() with no arguments allowed by 7.5.10 para 6 for
// ALLOCATABLE.
result.Add(*symbol, Expr<SomeType>{NullPointer{}});
continue;
}
if (IsNullObjectPointer(&*value)) {
AttachDeclaration(
Warn(common::LanguageFeature::
NullMoldAllocatableComponentValue,
expr.source,
"NULL() with arguments is not standard conforming as the value for allocatable component '%s'"_port_en_US,
symbol->name()),
*symbol);
// proceed to check type & shape
} else {
AttachDeclaration(
Say(expr.source,
"A NULL procedure pointer may not be used as the value for component '%s'"_err_en_US,
symbol->name()),
*symbol);
continue;
}
if (symbol->has<semantics::TypeParamDetails>()) {
Say(exprSource,
"Type parameter '%s' may not appear as a component of a structure constructor"_err_en_US,
symbol->name());
}
if (!(symbol->has<semantics::ProcEntityDetails>() ||
symbol->has<semantics::ObjectEntityDetails>())) {
continue; // recovery
}
if (IsPointer(*symbol)) { // C7104, C7105, C1594(4)
semantics::CheckStructConstructorPointerComponent(
context_, *symbol, value, innermost);
result.Add(*symbol, Fold(std::move(value)));
continue;
}
if (IsNullPointer(&value)) {
if (IsAllocatable(*symbol)) {
if (IsBareNullPointer(&value)) {
// NULL() with no arguments allowed by 7.5.10 para 6 for
// ALLOCATABLE.
result.Add(*symbol, Expr<SomeType>{NullPointer{}});
continue;
}
if (IsNullObjectPointer(&value)) {
AttachDeclaration(
Warn(common::LanguageFeature::NullMoldAllocatableComponentValue,
exprSource,
"NULL() with arguments is not standard conforming as the value for allocatable component '%s'"_port_en_US,
symbol->name()),
*symbol);
// proceed to check type & shape
} else {
AttachDeclaration(
Say(expr.source,
"A NULL pointer may not be used as the value for component '%s'"_err_en_US,
Say(exprSource,
"A NULL procedure pointer may not be used as the value for component '%s'"_err_en_US,
symbol->name()),
*symbol);
continue;
}
} else if (IsNullAllocatable(&*value) && IsAllocatable(*symbol)) {
result.Add(*symbol, Expr<SomeType>{NullPointer{}});
} else {
AttachDeclaration(
Say(exprSource,
"A NULL pointer may not be used as the value for component '%s'"_err_en_US,
symbol->name()),
*symbol);
continue;
} else if (auto *derived{evaluate::GetDerivedTypeSpec(
evaluate::DynamicType::From(*symbol))}) {
if (auto iter{FindPointerPotentialComponent(*derived)};
iter && pureContext) { // F'2023 C15104(4)
if (const Symbol *
visible{semantics::FindExternallyVisibleObject(
*value, *pureContext)}) {
Say(expr.source,
"The externally visible object '%s' may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
visible->name(), symbol->name(),
iter.BuildResultDesignatorName());
} else if (ExtractCoarrayRef(*value)) {
Say(expr.source,
"A coindexed object may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
symbol->name(), iter.BuildResultDesignatorName());
}
}
} else if (IsNullAllocatable(&value) && IsAllocatable(*symbol)) {
result.Add(*symbol, Expr<SomeType>{NullPointer{}});
continue;
} else if (auto *derived{evaluate::GetDerivedTypeSpec(
evaluate::DynamicType::From(*symbol))}) {
if (auto iter{FindPointerPotentialComponent(*derived)};
iter && pureContext) { // F'2023 C15104(4)
if (const Symbol *
visible{semantics::FindExternallyVisibleObject(
value, *pureContext)}) {
Say(exprSource,
"The externally visible object '%s' may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
visible->name(), symbol->name(),
iter.BuildResultDesignatorName());
} else if (ExtractCoarrayRef(value)) {
Say(exprSource,
"A coindexed object may not be used in a pure procedure as the value for component '%s' which has the pointer component '%s'"_err_en_US,
symbol->name(), iter.BuildResultDesignatorName());
}
}
// Make implicit conversion explicit to allow folding of the structure
// constructors and help semantic checking, unless the component is
// allocatable, in which case the value could be an unallocated
// allocatable (see Fortran 2018 7.5.10 point 7). The explicit
// convert would cause a segfault. Lowering will deal with
// conditionally converting and preserving the lower bounds in this
// case.
if (MaybeExpr converted{ImplicitConvertTo(
*symbol, std::move(*value), IsAllocatable(*symbol))}) {
if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
AttachDeclaration(
Say(expr.source,
"Rank-%d array value is not compatible with scalar component '%s'"_err_en_US,
GetRank(*valueShape), symbol->name()),
*symbol);
} else {
auto checked{
CheckConformance(messages, *componentShape, *valueShape,
CheckConformanceFlags::RightIsExpandableDeferred,
"component", "value")};
if (checked && *checked && GetRank(*componentShape) > 0 &&
GetRank(*valueShape) == 0 &&
(IsDeferredShape(*symbol) ||
!IsExpandableScalar(*converted, GetFoldingContext(),
*componentShape, true /*admit PURE call*/))) {
AttachDeclaration(
Say(expr.source,
"Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
symbol->name()),
*symbol);
}
if (checked.value_or(true)) {
result.Add(*symbol, std::move(*converted));
}
}
}
// Make implicit conversion explicit to allow folding of the structure
// constructors and help semantic checking, unless the component is
// allocatable, in which case the value could be an unallocated
// allocatable (see Fortran 2018 7.5.10 point 7). The explicit
// convert would cause a segfault. Lowering will deal with
// conditionally converting and preserving the lower bounds in this
// case.
if (MaybeExpr converted{ImplicitConvertTo(
*symbol, std::move(value), IsAllocatable(*symbol))}) {
if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
AttachDeclaration(
Say(exprSource,
"Rank-%d array value is not compatible with scalar component '%s'"_err_en_US,
GetRank(*valueShape), symbol->name()),
*symbol);
} else {
Say(expr.source, "Shape of value cannot be determined"_err_en_US);
auto checked{CheckConformance(messages, *componentShape,
*valueShape, CheckConformanceFlags::RightIsExpandableDeferred,
"component", "value")};
if (checked && *checked && GetRank(*componentShape) > 0 &&
GetRank(*valueShape) == 0 &&
(IsDeferredShape(*symbol) ||
!IsExpandableScalar(*converted, GetFoldingContext(),
*componentShape, true /*admit PURE call*/))) {
AttachDeclaration(
Say(exprSource,
"Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
symbol->name()),
*symbol);
}
if (checked.value_or(true)) {
result.Add(*symbol, std::move(*converted));
}
}
} else {
AttachDeclaration(
Say(expr.source,
"Shape of component '%s' cannot be determined"_err_en_US,
symbol->name()),
*symbol);
}
} else if (auto symType{DynamicType::From(symbol)}) {
if (IsAllocatable(*symbol) && symType->IsUnlimitedPolymorphic() &&
valueType) {
// ok
} else if (valueType) {
AttachDeclaration(
Say(expr.source,
"Value in structure constructor of type '%s' is "
"incompatible with component '%s' of type '%s'"_err_en_US,
valueType->AsFortran(), symbol->name(),
symType->AsFortran()),
*symbol);
} else {
AttachDeclaration(
Say(expr.source,
"Value in structure constructor is incompatible with "
"component '%s' of type %s"_err_en_US,
symbol->name(), symType->AsFortran()),
*symbol);
Say(exprSource, "Shape of value cannot be determined"_err_en_US);
}
} else {
AttachDeclaration(
Say(exprSource,
"Shape of component '%s' cannot be determined"_err_en_US,
symbol->name()),
*symbol);
}
} else if (auto symType{DynamicType::From(symbol)}) {
if (IsAllocatable(*symbol) && symType->IsUnlimitedPolymorphic() &&
valueType) {
// ok
} else if (valueType) {
AttachDeclaration(
Say(exprSource,
"Value in structure constructor of type '%s' is incompatible with component '%s' of type '%s'"_err_en_US,
valueType->AsFortran(), symbol->name(), symType->AsFortran()),
*symbol);
} else {
AttachDeclaration(
Say(exprSource,
"Value in structure constructor is incompatible with component '%s' of type %s"_err_en_US,
symbol->name(), symType->AsFortran()),
*symbol);
}
}
}
@@ -2381,10 +2356,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(
} else if (IsPointer(symbol)) {
result.Add(symbol, Expr<SomeType>{NullPointer{}});
} else if (object) { // C799
AttachDeclaration(Say(typeName,
"Structure constructor lacks a value for "
"component '%s'"_err_en_US,
symbol.name()),
AttachDeclaration(
Say(typeName,
"Structure constructor lacks a value for component '%s'"_err_en_US,
symbol.name()),
symbol);
}
}
@@ -2394,6 +2369,45 @@ MaybeExpr ExpressionAnalyzer::Analyze(
return AsMaybeExpr(Expr<SomeDerived>{std::move(result)});
}
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::StructureConstructor &structure) {
const auto &parsedType{std::get<parser::DerivedTypeSpec>(structure.t)};
parser::Name structureType{std::get<parser::Name>(parsedType.t)};
parser::CharBlock &typeName{structureType.source};
if (semantics::Symbol * typeSymbol{structureType.symbol}) {
if (typeSymbol->has<semantics::DerivedTypeDetails>()) {
semantics::DerivedTypeSpec dtSpec{typeName, typeSymbol->GetUltimate()};
if (!CheckIsValidForwardReference(dtSpec)) {
return std::nullopt;
}
}
}
if (!parsedType.derivedTypeSpec) {
return std::nullopt;
}
auto restorer{AllowNullPointer()}; // NULL() can be a valid component
std::list<ComponentSpec> componentSpecs;
for (const auto &component :
std::get<std::list<parser::ComponentSpec>>(structure.t)) {
const parser::Expr &expr{
std::get<parser::ComponentDataSource>(component.t).v.value()};
auto restorer{GetContextualMessages().SetLocation(expr.source)};
ComponentSpec compSpec;
compSpec.exprSource = expr.source;
compSpec.expr = Analyze(expr);
if (const auto &kw{std::get<std::optional<parser::Keyword>>(component.t)}) {
compSpec.source = kw->v.source;
compSpec.hasKeyword = true;
compSpec.keywordSymbol = kw->v.symbol;
} else {
compSpec.source = expr.source;
}
componentSpecs.emplace_back(std::move(compSpec));
}
return CheckStructureConstructor(
typeName, DEREF(parsedType.derivedTypeSpec), std::move(componentSpecs));
}
static std::optional<parser::CharBlock> GetPassName(
const semantics::Symbol &proc) {
return common::visit(
@@ -2841,24 +2855,26 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
const Symbol &symbol, const ActualArguments &actuals,
const AdjustActuals &adjustActuals, bool isSubroutine,
bool mightBeStructureConstructor) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const Symbol *nonElemental{nullptr}; // matching non-elemental specific
const Symbol &ultimate{symbol.GetUltimate()};
int crtMatchingDistance{cudaInfMatchingValue};
// Check for a match with an explicit INTRINSIC
const Symbol *explicitIntrinsic{nullptr};
if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
parser::Messages buffer;
auto restorer{foldingContext_.messages().SetMessages(buffer)};
auto restorer{GetContextualMessages().SetMessages(buffer)};
ActualArguments localActuals{actuals};
if (context_.intrinsics().Probe(
CallCharacteristics{ultimate.name().ToString(), isSubroutine},
localActuals, foldingContext_) &&
!buffer.AnyFatalError()) {
return {&ultimate, false};
explicitIntrinsic = &ultimate;
}
}
if (const auto *details{ultimate.detailsIf<semantics::GenericDetails>()}) {
for (const Symbol &specific0 : details->specificProcs()) {
const Symbol *elemental{nullptr}; // matching elemental specific proc
const Symbol *nonElemental{nullptr}; // matching non-elemental specific
const auto *genericDetails{ultimate.detailsIf<semantics::GenericDetails>()};
if (genericDetails && !explicitIntrinsic) {
int crtMatchingDistance{cudaInfMatchingValue};
for (const Symbol &specific0 : genericDetails->specificProcs()) {
const Symbol &specific1{BypassGeneric(specific0)};
if (isSubroutine != !IsFunction(specific1)) {
continue;
@@ -2911,24 +2927,92 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
}
}
}
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;
}
}
// Is there a derived type of the same name?
const Symbol *derivedType{nullptr};
if (mightBeStructureConstructor && !isSubroutine && genericDetails) {
if (const Symbol * dt{genericDetails->derivedType()}) {
const Symbol &ultimate{dt->GetUltimate()};
if (ultimate.has<semantics::DerivedTypeDetails>()) {
derivedType = &ultimate;
}
}
if (mightBeStructureConstructor && details->derivedType()) {
return {details->derivedType(), false};
}
// F'2023 C7108 checking. No Fortran compiler actually enforces this
// constraint, so it's just a portability warning here.
if (derivedType && (explicitIntrinsic || nonElemental || elemental) &&
context_.ShouldWarn(
common::LanguageFeature::AmbiguousStructureConstructor)) {
// See whethr there's ambiguity with a structure constructor.
bool possiblyAmbiguous{true};
if (const semantics::Scope * dtScope{derivedType->scope()}) {
parser::Messages buffer;
auto restorer{GetContextualMessages().SetMessages(buffer)};
std::list<ComponentSpec> componentSpecs;
for (const auto &actual : actuals) {
if (actual) {
ComponentSpec compSpec;
if (const Expr<SomeType> *expr{actual->UnwrapExpr()}) {
compSpec.expr = *expr;
} else {
possiblyAmbiguous = false;
}
if (auto loc{actual->sourceLocation()}) {
compSpec.source = compSpec.exprSource = *loc;
}
if (auto kw{actual->keyword()}) {
compSpec.hasKeyword = true;
compSpec.keywordSymbol = dtScope->FindComponent(*kw);
}
componentSpecs.emplace_back(std::move(compSpec));
} else {
possiblyAmbiguous = false;
}
}
semantics::DerivedTypeSpec dtSpec{derivedType->name(), *derivedType};
dtSpec.set_scope(*dtScope);
possiblyAmbiguous = possiblyAmbiguous &&
CheckStructureConstructor(
derivedType->name(), dtSpec, std::move(componentSpecs))
.has_value() &&
!buffer.AnyFatalError();
}
if (possiblyAmbiguous) {
if (explicitIntrinsic) {
Warn(common::LanguageFeature::AmbiguousStructureConstructor,
"Reference to the intrinsic function '%s' is ambiguous with a structure constructor of the same name"_port_en_US,
symbol.name());
} else {
Warn(common::LanguageFeature::AmbiguousStructureConstructor,
"Reference to generic function '%s' (resolving to specific '%s') is ambiguous with a structure constructor of the same name"_port_en_US,
symbol.name(),
nonElemental ? nonElemental->name() : elemental->name());
}
}
}
// Return the right resolution, if there is one. Explicit intrinsics
// are preferred, then non-elements specifics, then elementals, and
// lastly structure constructors.
if (explicitIntrinsic) {
return {explicitIntrinsic, false};
} else 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;
}
}
}
// Structure constructor?
if (derivedType) {
return {derivedType, false};
}
// Check for generic or explicit INTRINSIC of the same name in outer scopes.
// See 15.5.5.2 for details.

1
flang/lib/Support/Fortran-features.cpp
View File

@@ -45,6 +45,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnLanguage_.set(LanguageFeature::HollerithPolymorphic);
warnLanguage_.set(LanguageFeature::ListDirectedSize);
warnLanguage_.set(LanguageFeature::IgnoreIrrelevantAttributes);
warnLanguage_.set(LanguageFeature::AmbiguousStructureConstructor);
warnUsage_.set(UsageWarning::ShortArrayActual);
warnUsage_.set(UsageWarning::FoldingException);
warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);

41
flang/test/Semantics/c7108.f90 Normal file
View File

@@ -0,0 +1,41 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
! F'2023 C7108 is portably unenforced.
module m
type foo
integer n
end type
interface foo
procedure bar0, bar1, bar2, bar3
end interface
contains
type(foo) function bar0(n)
integer, intent(in) :: n
print *, 'bar0'
bar0%n = n
end
type(foo) function bar1()
print *, 'bar1'
bar1%n = 1
end
type(foo) function bar2(a)
real, intent(in) :: a
print *, 'bar2'
bar2%n = a
end
type(foo) function bar3(L)
logical, intent(in) :: L
print *, 'bar3'
bar3%n = merge(4,5,L)
end
end
program p
use m
type(foo) x
x = foo(); print *, x ! ok, not ambiguous
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'bar0') is ambiguous with a structure constructor of the same name
x = foo(2); print *, x ! ambigous
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'bar2') is ambiguous with a structure constructor of the same name
x = foo(3.); print *, x ! ambiguous due to data conversion
x = foo(.true.); print *, x ! ok, not ambigous
end

4
flang/test/Semantics/generic09.f90
View File

@@ -1,4 +1,5 @@
! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
module m1
type foo
integer n
@@ -32,6 +33,9 @@ module m3
end
end
!CHECK: portability: Reference to generic function 'foo' (resolving to specific 'f1') is ambiguous with a structure constructor of the same name
!CHECK: portability: Reference to generic function 'foo' (resolving to specific 'f2') is ambiguous with a structure constructor of the same name
program main
use m3
type(foo) x

3
flang/test/Semantics/resolve11.f90
View File

@@ -66,7 +66,8 @@ subroutine s4
!ERROR: 'fun' is PRIVATE in 'm4'
use m4, only: foo, fun
type(foo) x ! ok
print *, foo() ! ok
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'fun') is ambiguous with a structure constructor of the same name
print *, foo()
end
module m5

2
flang/test/Semantics/resolve17.f90
View File

@@ -290,6 +290,7 @@ module m14d
contains
subroutine test
real :: y
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'bar') is ambiguous with a structure constructor of the same name
y = foo(1.0)
x = foo(2)
end subroutine
@@ -301,6 +302,7 @@ module m14e
contains
subroutine test
real :: y
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'bar') is ambiguous with a structure constructor of the same name
y = foo(1.0)
x = foo(2)
end subroutine

1
flang/test/Semantics/resolve18.f90
View File

@@ -348,6 +348,7 @@ subroutine s_21_23
use m21
use m23
type(foo) x ! Intel and NAG error
!PORTABILITY: Reference to generic function 'foo' (resolving to specific 'f1') is ambiguous with a structure constructor of the same name
print *, foo(1.) ! Intel error
print *, foo(1.,2.,3.) ! Intel error
call ext(foo) ! GNU and Intel error