[flang-commits] [flang] 8594b05 - [flang] Accept POINTER followed by INTERFACE
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 9 18:37:22 PDT 2022
Author: Peter Klausler
Date: 2022-05-09T18:37:09-07:00
New Revision: 8594b051fb40312e991d94f0c7eb09accd8ac822
URL: https://github.com/llvm/llvm-project/commit/8594b051fb40312e991d94f0c7eb09accd8ac822
DIFF: https://github.com/llvm/llvm-project/commit/8594b051fb40312e991d94f0c7eb09accd8ac822.diff
LOG: [flang] Accept POINTER followed by INTERFACE
As is already supported for dummy procedures, we need to also accept
declarations of procedure pointers that consist of a POINTER attribute
statement followed by an INTERFACE block. (The case of an INTERFACE
block followed by a POINTER statement already works.)
While cleaning this case up, adjust the utility predicate IsProcedurePointer()
to recognize it (namely a SubprogramDetails symbol with Attr::POINTER)
and delete IsProcName(). Extend tests, and add better comments to
symbol.h to document the two ways in which procedure pointers are
represented.
Differential Revision: https://reviews.llvm.org/D125139
Added:
Modified:
flang/include/flang/Semantics/symbol.h
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Semantics/check-nullify.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/nullify02.f90
flang/test/Semantics/procinterface01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index d10c1fe9c12e6..874c9d89a23e4 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -76,6 +76,9 @@ class WithBindName {
std::optional<std::string> 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 @@ class WithPassArg {
std::optional<SourceName> 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
index 4f06af023dfb9..27c9f36727d91 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -96,7 +96,6 @@ bool IsStmtFunctionResult(const Symbol &);
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
index 6fee72ae84195..6dc4f6a9e611f 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1266,7 +1266,8 @@ const Symbol *FindCommonBlockContaining(const Symbol &original) {
bool IsProcedurePointer(const Symbol &original) {
const Symbol &symbol{GetAssociationRoot(original)};
- return symbol.has<ProcEntityDetails>() && IsPointer(symbol);
+ return IsPointer(symbol) &&
+ (symbol.has<ProcEntityDetails>() || symbol.has<SubprogramDetails>());
}
// 3.11 automatic data object
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index fa29e5466f247..056490ec41986 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -301,7 +301,7 @@ struct TypeBuilder {
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
index 6b3c8d4daf0fa..c9b3f1077bdc7 100644
--- a/flang/lib/Semantics/check-nullify.cpp
+++ b/flang/lib/Semantics/check-nullify.cpp
@@ -29,9 +29,10 @@ void NullifyChecker::Leave(const parser::NullifyStmt &nullifyStmt) {
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
index 97b8f7f1094f6..f392288bffb42 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -375,8 +375,16 @@ bool DataInitializationCompiler<DSV>::InitElement(
} else if (isProcPointer) {
if (evaluate::IsProcedure(*expr)) {
if (CheckPointerAssignment(context, designator, *expr)) {
- GetImage().AddPointer(offsetSymbol.offset(), *expr);
- return true;
+ if (lastSymbol->has<ProcEntityDetails>()) {
+ 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
index f13c291a80884..114b64508c760 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3592,6 +3592,9 @@ void SubprogramVisitor::CheckExtantProc(
const parser::Name &name, Symbol::Flag subpFlag) {
if (auto *prev{FindSymbol(name)}) {
if (IsDummy(*prev)) {
+ } else if (auto *entity{prev->detailsIf<EntityDetails>()};
+ 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 &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
symbol->ReplaceName(name.source);
symbol->set(subpFlag);
PushScope(Scope::Kind::Subprogram, symbol);
- auto &details{symbol->get<SubprogramDetails>()};
if (inInterfaceBlock()) {
+ auto &details{symbol->get<SubprogramDetails>()};
details.set_isInterface();
if (isAbstract()) {
symbol->attrs().set(Attr::ABSTRACT);
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 87c842de88427..cb485bc11cdb3 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -250,11 +250,6 @@ bool IsPointerDummy(const Symbol &symbol) {
return IsPointer(symbol) && IsDummy(symbol);
}
-// proc-name
-bool IsProcName(const Symbol &symbol) {
- return symbol.GetUltimate().has<ProcEntityDetails>();
-}
-
bool IsBindCProcedure(const Symbol &symbol) {
if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
if (const Symbol * procInterface{procDetails->interface().symbol()}) {
diff --git a/flang/test/Semantics/nullify02.f90 b/flang/test/Semantics/nullify02.f90
index 92126dce7d85e..e7332af78a6de 100644
--- 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
index e75a13066a9a5..ab8f93c292c99 100644
--- 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 @@ real function abstract1(x)
!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)
More information about the flang-commits
mailing list