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 @@ -117,9 +117,12 @@ const Symbol *ProcedureDesignator::GetInterfaceSymbol() const { if (const Symbol * symbol{GetSymbol()}) { - if (const auto *details{ - symbol->detailsIf()}) { - return details->interface().symbol(); + const Symbol &ultimate{symbol->GetUltimate()}; + if (const auto *proc{ultimate.detailsIf()}) { + return proc->interface().symbol(); + } else if (const auto *binding{ + ultimate.detailsIf()}) { + return &binding->symbol(); } } return nullptr; diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -53,8 +53,7 @@ evaluate::CheckSpecificationExpr(x, DEREF(scope_), foldingContext_); } void CheckValue(const Symbol &, const DerivedTypeSpec *); - void CheckVolatile( - const Symbol &, bool isAssociated, const DerivedTypeSpec *); + void CheckVolatile(const Symbol &, const DerivedTypeSpec *); void CheckPointer(const Symbol &); void CheckPassArg( const Symbol &proc, const Symbol *interface, const WithPassArg &); @@ -172,22 +171,18 @@ context_.set_location(symbol.name()); const DeclTypeSpec *type{symbol.GetType()}; const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr}; - bool isAssociated{symbol.has() || symbol.has()}; - if (symbol.attrs().test(Attr::VOLATILE)) { - CheckVolatile(symbol, isAssociated, derived); - } - if (isAssociated) { - if (const auto *details{symbol.detailsIf()}) { - CheckHostAssoc(symbol, *details); - } - return; // no other checks on associated symbols - } - if (IsPointer(symbol)) { - CheckPointer(symbol); - } + bool isDone{false}; std::visit( common::visitors{ - [&](const ProcBindingDetails &x) { CheckProcBinding(symbol, x); }, + [&](const UseDetails &x) { isDone = true; }, + [&](const HostAssocDetails &x) { + CheckHostAssoc(symbol, x); + isDone = true; + }, + [&](const ProcBindingDetails &x) { + CheckProcBinding(symbol, x); + isDone = true; + }, [&](const ObjectEntityDetails &x) { CheckObjectEntity(symbol, x); }, [&](const ProcEntityDetails &x) { CheckProcEntity(symbol, x); }, [&](const SubprogramDetails &x) { CheckSubprogram(symbol, x); }, @@ -196,6 +191,15 @@ [](const auto &) {}, }, symbol.details()); + if (symbol.attrs().test(Attr::VOLATILE)) { + CheckVolatile(symbol, derived); + } + if (isDone) { + return; // following checks do not apply + } + if (IsPointer(symbol)) { + CheckPointer(symbol); + } if (InPure()) { if (IsSaved(symbol)) { messages_.Say( @@ -1279,7 +1283,7 @@ return common::GetPtrFromOptional(it->second); } -void CheckHelper::CheckVolatile(const Symbol &symbol, bool isAssociated, +void CheckHelper::CheckVolatile(const Symbol &symbol, const DerivedTypeSpec *derived) { // C866 - C868 if (IsIntentIn(symbol)) { messages_.Say( @@ -1288,7 +1292,7 @@ if (IsProcedure(symbol)) { messages_.Say("VOLATILE attribute may apply only to a variable"_err_en_US); } - if (isAssociated) { + if (symbol.has() || symbol.has()) { const Symbol &ultimate{symbol.GetUltimate()}; if (IsCoarray(ultimate)) { messages_.Say( diff --git a/flang/test/Semantics/call17.f90 b/flang/test/Semantics/call17.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/call17.f90 @@ -0,0 +1,19 @@ +! RUN: %f18 -fparse-only $s 2>&1 | FileCheck %s + +! Regression test: don't emit a bogus error about an invalid specification expression +! in the declaration of a binding + +module m + type :: t + integer :: n + contains + !CHECK-NOT: Invalid specification expression + procedure :: binding => func + end type + contains + function func(x) + class(t), intent(in) :: x + character(len=x%n) :: func + func = ' ' + end function +end module diff --git a/flang/test/Semantics/resolve88.f90 b/flang/test/Semantics/resolve88.f90 --- a/flang/test/Semantics/resolve88.f90 +++ b/flang/test/Semantics/resolve88.f90 @@ -11,8 +11,8 @@ real, allocatable, codimension[:] :: allocatableField !ERROR: Component 'deferredfield' is a coarray and must have the ALLOCATABLE attribute real, codimension[:] :: deferredField - !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray !ERROR: Component 'pointerfield' is a coarray and must have the ALLOCATABLE attribute + !ERROR: 'pointerfield' may not have the POINTER attribute because it is a coarray real, pointer, codimension[:] :: pointerField !ERROR: Component 'realfield' is a coarray and must have the ALLOCATABLE attribute and have a deferred coshape real, codimension[*] :: realField