[flang-commits] [flang] [flang] Ensure that DATA converter can cope with proc ptr error (PR #90973)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri May 3 08:22:37 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/90973
Multiple definitions of a procedure pointer with DATA statements should elicit an error message, not a compiler crash.
Fixes https://github.com/llvm/llvm-project/issues/90944.
>From a19d71be90e0740f7731990e4f41d10afaba9457 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 3 May 2024 07:06:51 -0700
Subject: [PATCH] [flang] Ensure that DATA converter can cope with proc ptr
error
Multiple definitions of a procedure pointer with DATA statements
should elicit an error message, not a compiler crash.
Fixes https://github.com/llvm/llvm-project/issues/90944.
---
flang/include/flang/Evaluate/tools.h | 6 ++++--
flang/lib/Evaluate/fold-designator.cpp | 28 ++++++++++++++++----------
flang/lib/Evaluate/tools.cpp | 6 +++---
flang/test/Semantics/data01.f90 | 2 +-
flang/test/Semantics/data23.f90 | 18 +++++++++++++++++
5 files changed, 43 insertions(+), 17 deletions(-)
create mode 100644 flang/test/Semantics/data23.f90
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index ca14c144af2d60..cb750d5e82d8ca 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -152,9 +152,11 @@ std::optional<Expr<SomeType>> AsGenericExpr(const Symbol &);
// Propagate std::optional from input to output.
template <typename A>
std::optional<Expr<SomeType>> AsGenericExpr(std::optional<A> &&x) {
- if (!x)
+ if (x) {
+ return AsGenericExpr(std::move(*x));
+ } else {
return std::nullopt;
- return AsGenericExpr(std::move(*x));
+ }
}
template <typename A>
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index 6952436681f753..0d8c22fb297708 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -273,9 +273,8 @@ static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
if (IsAllocatableOrPointer(symbol)) {
return entity.IsSymbol() ? DataRef{symbol}
: DataRef{std::move(entity.GetComponent())};
- }
- std::optional<DataRef> result;
- if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
+ } else if (std::optional<DynamicType> type{DynamicType::From(symbol)}) {
+ std::optional<DataRef> result;
if (!type->IsUnlimitedPolymorphic()) {
if (std::optional<Shape> shape{GetShape(context, symbol)}) {
if (GetRank(*shape) > 0) {
@@ -289,7 +288,7 @@ static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
: DataRef{std::move(entity.GetComponent())};
}
if (result && type->category() == TypeCategory::Derived &&
- size < result->GetLastSymbol().size()) {
+ size <= result->GetLastSymbol().size()) {
if (const Symbol *
component{OffsetToUniqueComponent(
type->GetDerivedTypeSpec(), offset)}) {
@@ -298,25 +297,32 @@ static std::optional<DataRef> OffsetToDataRef(FoldingContext &context,
NamedEntity{Component{std::move(*result), *component}}, offset,
size);
}
- result.reset();
}
}
}
+ return result;
+ } else {
+ return std::nullopt;
}
- return result;
}
// Reconstructs a Designator from a symbol, an offset, and a size.
+// Returns a ProcedureDesignator in the case of a whole procedure pointer.
std::optional<Expr<SomeType>> OffsetToDesignator(FoldingContext &context,
const Symbol &baseSymbol, ConstantSubscript offset, std::size_t size) {
if (offset < 0) {
return std::nullopt;
- }
- if (std::optional<DataRef> dataRef{
- OffsetToDataRef(context, NamedEntity{baseSymbol}, offset, size)}) {
+ } else if (std::optional<DataRef> dataRef{OffsetToDataRef(
+ context, NamedEntity{baseSymbol}, offset, size)}) {
const Symbol &symbol{dataRef->GetLastSymbol()};
- if (std::optional<Expr<SomeType>> result{
- AsGenericExpr(std::move(*dataRef))}) {
+ if (IsProcedurePointer(symbol)) {
+ if (std::holds_alternative<SymbolRef>(dataRef->u)) {
+ return Expr<SomeType>{ProcedureDesignator{symbol}};
+ } else if (auto *component{std::get_if<Component>(&dataRef->u)}) {
+ return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
+ }
+ } else if (std::optional<Expr<SomeType>> result{
+ AsGenericExpr(std::move(*dataRef))}) {
if (IsAllocatableOrPointer(symbol)) {
} else if (auto type{DynamicType::From(symbol)}) {
if (auto elementBytes{
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 9a5f9130632ee8..826b97b87bf3f8 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -28,11 +28,11 @@ namespace Fortran::evaluate {
static constexpr bool allowOperandDuplication{false};
std::optional<Expr<SomeType>> AsGenericExpr(DataRef &&ref) {
- const Symbol &symbol{ref.GetLastSymbol()};
- if (auto dyType{DynamicType::From(symbol)}) {
+ if (auto dyType{DynamicType::From(ref.GetLastSymbol())}) {
return TypedWrapper<Designator, DataRef>(*dyType, std::move(ref));
+ } else {
+ return std::nullopt;
}
- return std::nullopt;
}
std::optional<Expr<SomeType>> AsGenericExpr(const Symbol &symbol) {
diff --git a/flang/test/Semantics/data01.f90 b/flang/test/Semantics/data01.f90
index 9046487fa1766e..fe2d16e95ee1f7 100644
--- a/flang/test/Semantics/data01.f90
+++ b/flang/test/Semantics/data01.f90
@@ -67,6 +67,6 @@ subroutine CheckValue
!ERROR: DATA statement value 'b(1_8)' for 'z' is not a constant
data z / b(1) /
type(hasAlloc) ha
- !ERROR: DATA statement value 'hasalloc(a=0_4)' for 'ha' is not a constant
+ !ERROR: DATA statement value 'hasalloc(a=0_4)' for 'ha%a' is not a constant
data ha / hasAlloc(0) /
end
diff --git a/flang/test/Semantics/data23.f90 b/flang/test/Semantics/data23.f90
new file mode 100644
index 00000000000000..8210e9e62b813b
--- /dev/null
+++ b/flang/test/Semantics/data23.f90
@@ -0,0 +1,18 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+program p
+ interface
+ subroutine s
+ end subroutine
+ end interface
+ !ERROR: DATA statement initializations affect 'p' more than once
+ procedure(s), pointer :: p
+ type t
+ procedure(s), pointer, nopass :: p
+ end type
+ !ERROR: DATA statement initializations affect 'x%p' more than once
+ type(t) x
+ data p /s/
+ data p /s/
+ data x%p /s/
+ data x%p /s/
+end
More information about the flang-commits
mailing list