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 @@ -76,6 +76,9 @@ std::optional bindName_; }; +// A subroutine or function definition, or a subprogram interface defined +// in an INTERFACE block as part of the definition of a dummy procedure +// or a procedure pointer (with just POINTER). class SubprogramDetails : public WithBindName { public: bool isFunction() const { return result_ != nullptr; } @@ -244,7 +247,9 @@ std::optional passName_; }; -// A procedure pointer, dummy procedure, or external procedure +// A procedure pointer (other than one defined with POINTER and an +// INTERFACE block), a dummy procedure (without an INTERFACE but with +// EXTERNAL or use in a procedure reference), or external procedure. class ProcEntityDetails : public EntityDetails, public WithPassArg { public: ProcEntityDetails() = default; diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -96,7 +96,6 @@ bool IsPointerDummy(const Symbol &); bool IsBindCProcedure(const Symbol &); bool IsBindCProcedure(const Scope &); -bool IsProcName(const Symbol &); // proc-name // Returns a pointer to the function's symbol when true, else null const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &); bool IsOrContainsEventOrLockComponent(const Symbol &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1266,7 +1266,8 @@ bool IsProcedurePointer(const Symbol &original) { const Symbol &symbol{GetAssociationRoot(original)}; - return symbol.has() && IsPointer(symbol); + return IsPointer(symbol) && + (symbol.has() || symbol.has()); } // 3.11 automatic data object diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -301,7 +301,7 @@ if (componentHasNonDefaultLowerBounds(field)) TODO(converter.genLocation(field.name()), "lowering derived type components with non default lower bounds"); - if (IsProcName(field)) + if (IsProcedure(field)) TODO(converter.genLocation(field.name()), "procedure components"); mlir::Type ty = genSymbolType(field); // Do not add the parent component (component of the parents are diff --git a/flang/lib/Semantics/check-nullify.cpp b/flang/lib/Semantics/check-nullify.cpp --- a/flang/lib/Semantics/check-nullify.cpp +++ b/flang/lib/Semantics/check-nullify.cpp @@ -29,9 +29,10 @@ const Symbol *symbol{name.symbol}; if (context_.HasError(symbol)) { // already reported an error - } else if (!IsVariableName(*symbol) && !IsProcName(*symbol)) { + } else if (!IsVariableName(*symbol) && + !IsProcedurePointer(*symbol)) { messages.Say(name.source, - "name in NULLIFY statement must be a variable or procedure pointer name"_err_en_US); + "name in NULLIFY statement must be a variable or procedure pointer"_err_en_US); } else if (!IsPointer(*symbol)) { // C951 messages.Say(name.source, "name in NULLIFY statement must have the POINTER attribute"_err_en_US); diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp --- a/flang/lib/Semantics/data-to-inits.cpp +++ b/flang/lib/Semantics/data-to-inits.cpp @@ -375,8 +375,16 @@ } else if (isProcPointer) { if (evaluate::IsProcedure(*expr)) { if (CheckPointerAssignment(context, designator, *expr)) { - GetImage().AddPointer(offsetSymbol.offset(), *expr); - return true; + if (lastSymbol->has()) { + GetImage().AddPointer(offsetSymbol.offset(), *expr); + return true; + } else { + evaluate::AttachDeclaration( + exprAnalyzer_.context().Say( + "DATA statement initialization of procedure pointer '%s' declared using a POINTER statement and an INTERFACE instead of a PROCEDURE statement"_todo_en_US, + DescribeElement()), + *lastSymbol); + } } } else { exprAnalyzer_.Say( 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 @@ -3592,6 +3592,9 @@ const parser::Name &name, Symbol::Flag subpFlag) { if (auto *prev{FindSymbol(name)}) { if (IsDummy(*prev)) { + } else if (auto *entity{prev->detailsIf()}; + IsPointer(*prev) && !entity->type()) { + // POINTER attribute set before interface } else if (inInterfaceBlock() && currScope() != prev->owner()) { // Procedures in an INTERFACE block do not resolve to symbols // in scopes between the global scope and the current scope. @@ -3619,8 +3622,8 @@ symbol->ReplaceName(name.source); symbol->set(subpFlag); PushScope(Scope::Kind::Subprogram, symbol); - auto &details{symbol->get()}; if (inInterfaceBlock()) { + auto &details{symbol->get()}; details.set_isInterface(); if (isAbstract()) { symbol->attrs().set(Attr::ABSTRACT); diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -250,11 +250,6 @@ return IsPointer(symbol) && IsDummy(symbol); } -// proc-name -bool IsProcName(const Symbol &symbol) { - return symbol.GetUltimate().has(); -} - bool IsBindCProcedure(const Symbol &symbol) { if (const auto *procDetails{symbol.detailsIf()}) { if (const Symbol * procInterface{procDetails->interface().symbol()}) { diff --git a/flang/test/Semantics/nullify02.f90 b/flang/test/Semantics/nullify02.f90 --- a/flang/test/Semantics/nullify02.f90 +++ b/flang/test/Semantics/nullify02.f90 @@ -22,10 +22,10 @@ !ERROR: name in NULLIFY statement must have the POINTER attribute Nullify(pi) -!ERROR: name in NULLIFY statement must have the POINTER attribute +!ERROR: name in NULLIFY statement must be a variable or procedure pointer Nullify(prp) -!ERROR: name in NULLIFY statement must be a variable or procedure pointer name +!ERROR: name in NULLIFY statement must be a variable or procedure pointer Nullify(maxvalue) End Program diff --git a/flang/test/Semantics/procinterface01.f90 b/flang/test/Semantics/procinterface01.f90 --- a/flang/test/Semantics/procinterface01.f90 +++ b/flang/test/Semantics/procinterface01.f90 @@ -4,6 +4,8 @@ !DEF: /module1 Module module module1 + !DEF:/module1/abstract2 ABSTRACT, POINTER, PUBLIC (Subroutine) Subprogram + pointer :: abstract2 abstract interface !DEF: /module1/abstract1 ABSTRACT, PUBLIC (Function) Subprogram REAL(4) !DEF: /module1/abstract1/x INTENT(IN) ObjectEntity REAL(4) @@ -11,7 +13,15 @@ !REF: /module1/abstract1/x real, intent(in) :: x end function abstract1 + !REF:/module1/abstract2 + subroutine abstract2 + end subroutine + !DEF:/module1/abstract3 ABSTRACT, POINTER, PUBLIC (Subroutine) Subprogram + subroutine abstract3 + end subroutine end interface + !REF:/module1/abstract3 + pointer :: abstract3 interface !DEF: /module1/explicit1 EXTERNAL, PUBLIC (Function) Subprogram REAL(4)