[flang-commits] [flang] 3d7c836 - [flang] Rework name resolution of Cray pointer declarations
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jun 22 06:35:55 PDT 2023
Author: Peter Klausler
Date: 2023-06-22T06:35:42-07:00
New Revision: 3d7c8367ef7dbd0dd8a012843e1167de9f7b7b2f
URL: https://github.com/llvm/llvm-project/commit/3d7c8367ef7dbd0dd8a012843e1167de9f7b7b2f
DIFF: https://github.com/llvm/llvm-project/commit/3d7c8367ef7dbd0dd8a012843e1167de9f7b7b2f.diff
LOG: [flang] Rework name resolution of Cray pointer declarations
The current code has redundancy with the infrastructure for
declaration checking that can be replaced by better usage of
the parse tree walking framework. This also fixes LLVM flang
bug #58971.
Differential Revision: https://reviews.llvm.org/D153385
Added:
Modified:
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/resolve61.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4afc9c6b3c0d6..b9470c8386e1c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -422,14 +422,14 @@ class ImplicitRulesVisitor : public DeclTypeSpecVisitor {
};
// Track array specifications. They can occur in AttrSpec, EntityDecl,
-// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointerStmt, and
+// ObjectDecl, DimensionStmt, CommonBlockObject, BasedPointer, and
// ComponentDecl.
// 1. INTEGER, DIMENSION(10) :: x
// 2. INTEGER :: x(10)
// 3. ALLOCATABLE :: x(:)
// 4. DIMENSION :: x(10)
// 5. COMMON x(10)
-// 6. BasedPointerStmt
+// 6. POINTER(p,x(10))
class ArraySpecVisitor : public virtual BaseVisitor {
public:
void Post(const parser::ArraySpec &);
@@ -1003,7 +1003,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
void Post(const parser::CommonBlockObject &);
bool Pre(const parser::EquivalenceStmt &);
bool Pre(const parser::SaveStmt &);
- bool Pre(const parser::BasedPointerStmt &);
+ bool Pre(const parser::BasedPointer &);
+ void Post(const parser::BasedPointer &);
void PointerInitialization(
const parser::Name &, const parser::InitialDataTarget &);
@@ -5687,78 +5688,67 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
return false;
}
-bool DeclarationVisitor::Pre(const parser::BasedPointerStmt &x) {
- for (const parser::BasedPointer &bp : x.v) {
- const parser::ObjectName &pointerName{std::get<0>(bp.t)};
- const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
- auto *pointer{FindSymbol(pointerName)};
- if (!pointer) {
- pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
- } else if (!ConvertToObjectEntity(*pointer) || IsNamedConstant(*pointer)) {
- SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
- } else if (pointer->Rank() > 0) {
- SayWithDecl(pointerName, *pointer,
- "Cray pointer '%s' must be a scalar"_err_en_US);
- } else if (pointer->test(Symbol::Flag::CrayPointee)) {
- Say(pointerName,
- "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
- }
- pointer->set(Symbol::Flag::CrayPointer);
- const DeclTypeSpec &pointerType{MakeNumericType(TypeCategory::Integer,
- context().defaultKinds().subscriptIntegerKind())};
- const auto *type{pointer->GetType()};
- if (!type) {
- pointer->SetType(pointerType);
- } else if (*type != pointerType) {
- Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
- pointerName.source, pointerType.AsFortran());
- }
- // pmk: change parse tree to use DimensionStmt::Declaration in BasedPointerStmt, then change this
- // routine to a Post()
- if (ResolveName(pointeeName)) {
- Symbol &pointee{*pointeeName.symbol};
- if (pointee.has<UseDetails>()) {
- Say(pointeeName,
- "'%s' cannot be a Cray pointee as it is use-associated"_err_en_US);
- continue;
- } else if (!ConvertToObjectEntity(pointee) || IsNamedConstant(pointee)) {
- Say(pointeeName, "'%s' is not a variable"_err_en_US);
- continue;
- } else if (pointee.test(Symbol::Flag::CrayPointer)) {
- Say(pointeeName,
- "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
- } else if (pointee.test(Symbol::Flag::CrayPointee)) {
- Say(pointeeName,
- "'%s' was already declared as a Cray pointee"_err_en_US);
- } else {
- pointee.set(Symbol::Flag::CrayPointee);
- }
- if (const auto *pointeeType{pointee.GetType()}) {
- if (const auto *derived{pointeeType->AsDerived()}) {
- if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
- Say(pointeeName,
- "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US);
- }
- }
- }
- // process the pointee array-spec, if present
- BeginArraySpec();
- Walk(std::get<std::optional<parser::ArraySpec>>(bp.t));
- const auto &spec{arraySpec()};
- if (!spec.empty()) {
- auto &details{pointee.get<ObjectEntityDetails>()};
- if (details.shape().empty()) {
- details.set_shape(spec);
- } else {
- SayWithDecl(pointeeName, pointee,
- "Array spec was already declared for '%s'"_err_en_US);
+bool DeclarationVisitor::Pre(const parser::BasedPointer &) {
+ BeginArraySpec();
+ return true;
+}
+
+void DeclarationVisitor::Post(const parser::BasedPointer &bp) {
+ const parser::ObjectName &pointerName{std::get<0>(bp.t)};
+ auto *pointer{FindSymbol(pointerName)};
+ if (!pointer) {
+ pointer = &MakeSymbol(pointerName, ObjectEntityDetails{});
+ } else if (!ConvertToObjectEntity(*pointer)) {
+ SayWithDecl(pointerName, *pointer, "'%s' is not a variable"_err_en_US);
+ } else if (IsNamedConstant(*pointer)) {
+ SayWithDecl(pointerName, *pointer,
+ "'%s' is a named constant and may not be a Cray pointer"_err_en_US);
+ } else if (pointer->Rank() > 0) {
+ SayWithDecl(
+ pointerName, *pointer, "Cray pointer '%s' must be a scalar"_err_en_US);
+ } else if (pointer->test(Symbol::Flag::CrayPointee)) {
+ Say(pointerName,
+ "'%s' cannot be a Cray pointer as it is already a Cray pointee"_err_en_US);
+ }
+ pointer->set(Symbol::Flag::CrayPointer);
+ const DeclTypeSpec &pointerType{MakeNumericType(
+ TypeCategory::Integer, context().defaultKinds().subscriptIntegerKind())};
+ const auto *type{pointer->GetType()};
+ if (!type) {
+ pointer->SetType(pointerType);
+ } else if (*type != pointerType) {
+ Say(pointerName.source, "Cray pointer '%s' must have type %s"_err_en_US,
+ pointerName.source, pointerType.AsFortran());
+ }
+ const parser::ObjectName &pointeeName{std::get<1>(bp.t)};
+ DeclareObjectEntity(pointeeName);
+ if (Symbol * pointee{pointeeName.symbol}) {
+ if (!ConvertToObjectEntity(*pointee)) {
+ return;
+ }
+ if (IsNamedConstant(*pointee)) {
+ Say(pointeeName,
+ "'%s' is a named constant and may not be a Cray pointee"_err_en_US);
+ return;
+ }
+ if (pointee->test(Symbol::Flag::CrayPointer)) {
+ Say(pointeeName,
+ "'%s' cannot be a Cray pointee as it is already a Cray pointer"_err_en_US);
+ } else if (pointee->test(Symbol::Flag::CrayPointee)) {
+ Say(pointeeName, "'%s' was already declared as a Cray pointee"_err_en_US);
+ } else {
+ pointee->set(Symbol::Flag::CrayPointee);
+ }
+ if (const auto *pointeeType{pointee->GetType()}) {
+ if (const auto *derived{pointeeType->AsDerived()}) {
+ if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
+ Say(pointeeName,
+ "Type of Cray pointee '%s' is a non-sequence derived type"_err_en_US);
}
}
- ClearArraySpec();
- currScope().add_crayPointer(pointeeName.source, *pointer);
}
+ currScope().add_crayPointer(pointeeName.source, *pointer);
}
- return false;
}
bool DeclarationVisitor::Pre(const parser::NamelistStmt::Group &x) {
diff --git a/flang/test/Semantics/resolve61.f90 b/flang/test/Semantics/resolve61.f90
index 73f6ccbf96669..6728050243ec3 100644
--- a/flang/test/Semantics/resolve61.f90
+++ b/flang/test/Semantics/resolve61.f90
@@ -35,7 +35,7 @@ subroutine p5
subroutine p6
real b(8)
- !ERROR: Array spec was already declared for 'b'
+ !ERROR: The dimensions of 'b' have already been declared
pointer(a, b(4))
end
@@ -59,7 +59,7 @@ subroutine p8
pointer(t, a)
!ERROR: 's' is not a variable
pointer(s, b)
- !ERROR: 'k' is not a variable
+ !ERROR: 'k' is a named constant and may not be a Cray pointer
pointer(k, c)
contains
subroutine s
@@ -70,11 +70,11 @@ subroutine p9
integer(8), parameter :: k = 2
type t
end type
- !ERROR: 't' is not a variable
+ !ERROR: 't' is already declared in this scoping unit
pointer(a, t)
- !ERROR: 's' is not a variable
+ !ERROR: Declaration of 's' conflicts with its use as internal procedure
pointer(b, s)
- !ERROR: 'k' is not a variable
+ !ERROR: 'k' is a named constant and may not be a Cray pointee
pointer(c, k)
contains
subroutine s
@@ -87,7 +87,7 @@ module m10
end
subroutine p10
use m10
- !ERROR: 'b' cannot be a Cray pointee as it is use-associated
+ !ERROR: 'b' is use-associated from module 'm10' and cannot be re-declared
pointer(a, c),(d, b)
end
@@ -113,3 +113,11 @@ subroutine p12
!ERROR: Type of Cray pointee 'x2' is a non-sequence derived type
pointer(b, x2)
end
+
+subroutine p13
+ pointer(ip, x)
+ contains
+ subroutine s
+ pointer(ip, x) ! ok, local declaration
+ end
+end
More information about the flang-commits
mailing list