[flang-commits] [flang] [Flang] Allow pointer for data-ido-object (PR #204635)
via flang-commits
flang-commits at lists.llvm.org
Thu Jun 18 10:49:03 PDT 2026
llvmorg-github-actions[bot] wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-parser
Author: jon-gibney
<details>
<summary>Changes</summary>
The Fortran standard allows a data-ido-object to be a pointer. Remove the Scalar wrapper and check explicitly that it's either a pointer or a scalar.
Assisted by: Claude Opus
---
Full diff: https://github.com/llvm/llvm-project/pull/204635.diff
6 Files Affected:
- (modified) flang/include/flang/Parser/parse-tree.h (+1-1)
- (modified) flang/lib/Parser/Fortran-parsers.cpp (+1-1)
- (modified) flang/lib/Semantics/check-data.cpp (+8-3)
- (modified) flang/lib/Semantics/data-to-inits.cpp (+2-3)
- (modified) flang/lib/Semantics/resolve-names.cpp (+2-2)
- (added) flang/test/Semantics/data25.f90 (+61)
``````````diff
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index ee6288539395c..89c168bb75c28 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1538,7 +1538,7 @@ struct DataStmtValue {
// array-element | scalar-structure-component | data-implied-do
struct DataIDoObject {
UNION_CLASS_BOILERPLATE(DataIDoObject);
- std::variant<Scalar<common::Indirection<Designator>>,
+ std::variant<common::Indirection<Designator>,
common::Indirection<DataImpliedDo>>
u;
};
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index ebae6bfa53cab..0d1e83308ce39 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -950,7 +950,7 @@ TYPE_PARSER(parenthesized(construct<DataImpliedDo>(
// R841 data-i-do-object ->
// array-element | scalar-structure-component | data-implied-do
-TYPE_PARSER(construct<DataIDoObject>(scalar(indirect(designator))) ||
+TYPE_PARSER(construct<DataIDoObject>(indirect(designator)) ||
construct<DataIDoObject>(indirect(dataImpliedDo)))
// R843 data-stmt-value -> [data-stmt-repeat *] data-stmt-constant
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 9dbbc163d85b3..8d2bcb4eaf9b6 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -13,6 +13,7 @@
#include "check-data.h"
#include "data-to-inits.h"
+#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/traverse.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
@@ -211,10 +212,9 @@ static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879
void DataChecker::Leave(const parser::DataIDoObject &object) {
if (const auto *designator{
- std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
- &object.u)}) {
+ std::get_if<common::Indirection<parser::Designator>>(&object.u)}) {
if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
- auto source{parser::UnwrapRef<parser::Designator>(*designator).source};
+ auto source{designator->value().source};
DataVarChecker checker{exprAnalyzer_.context(), source};
if (checker(*expr)) {
if (checker.HasComponentWithoutSubscripts()) { // C880
@@ -223,6 +223,11 @@ void DataChecker::Leave(const parser::DataIDoObject &object) {
} else if (!IsValidDataObject(*expr)) {
exprAnalyzer_.context().Say(
source, "Data implied do object must be a variable"_err_en_US);
+ } else if (expr->Rank() != 0 && !evaluate::IsObjectPointer(*expr)) {
+ // R841 array-element or scalar-structure-component
+ // C877 allows it to be a pointer
+ exprAnalyzer_.context().Say(source,
+ "Data implied do object must be scalar or a pointer"_err_en_US);
} else {
return;
}
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index cd9ec3059afec..c087cea79ebbf 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -240,9 +240,8 @@ bool DataInitializationCompiler<DSV>::Scan(
const parser::DataIDoObject &object) {
return common::visit(
common::visitors{
- [&](const parser::Scalar<common::Indirection<parser::Designator>>
- &var) {
- return Scan(parser::UnwrapRef<parser::Designator>(var));
+ [&](const common::Indirection<parser::Designator> &var) {
+ return Scan(var.value());
},
[&](const common::Indirection<parser::DataImpliedDo> &ido) {
return Scan(ido.value());
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 6d2d0bf24b194..1f1cb13ddc89b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8405,8 +8405,8 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
bool ConstructVisitor::Pre(const parser::DataIDoObject &x) {
common::visit(
common::visitors{
- [&](const parser::Scalar<Indirection<parser::Designator>> &y) {
- const auto &designator{parser::UnwrapRef<parser::Designator>(y)};
+ [&](const Indirection<parser::Designator> &y) {
+ const auto &designator{y.value()};
Walk(designator);
const parser::Name &first{parser::GetFirstName(designator)};
if (first.symbol) {
diff --git a/flang/test/Semantics/data25.f90 b/flang/test/Semantics/data25.f90
new file mode 100644
index 0000000000000..3d56dfa8c506f
--- /dev/null
+++ b/flang/test/Semantics/data25.f90
@@ -0,0 +1,61 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test DATA statement pointer initialization with array pointer components
+! in implied DO loops.
+
+subroutine array_ptr
+ type ty
+ real, pointer :: ptr(:)
+ end type
+ real, target :: targ(10) = [(i, i=1,10)]
+ type(ty) :: x(5)
+ ! Array pointer component in implied DO - valid
+ data (x(i)%ptr, i=1,5) / 5*targ /
+end subroutine
+
+subroutine array_ptr_2d
+ type ty
+ real, pointer :: ptr(:)
+ end type
+ real, target :: targ(10) = [(i, i=1,10)]
+ type(ty) :: x(5,5)
+ ! Array pointer component in implied DO - valid
+ data ((x(i,j)%ptr, i=1,5),j=1,5) / 25*targ /
+end subroutine
+
+subroutine scalar_ptr
+ type ty
+ real, pointer :: ptr
+ end type
+ real, target :: targ = 1.0
+ type(ty) :: x(5)
+ ! Scalar pointer component in implied DO - valid
+ data (x(i)%ptr, i=1,5) / 5*targ /
+end subroutine
+
+subroutine scalar_ptr_2d
+ type ty
+ real, pointer :: ptr
+ end type
+ real, target :: targ = 1.0
+ type(ty) :: x(5,5)
+ ! Scalar pointer component in implied DO - valid
+ data ((x(i,j)%ptr, i=1,5),j=1,5) / 25*targ /
+end subroutine
+
+subroutine array_object
+ type ty
+ real :: arr(10)
+ end type
+ type(ty) :: x(5)
+ !ERROR: Data implied do object must be scalar or a pointer
+ data (x(i)%arr, i=1,5) / 50*0.0 /
+end subroutine
+
+subroutine array_object_2d
+ type ty
+ real :: arr(10)
+ end type
+ type(ty) :: x(5,5)
+ !ERROR: Data implied do object must be scalar or a pointer
+ data ((x(i,j)%arr, i=1,5),j=1,5) / 250*0.0 /
+end subroutine
``````````
</details>
https://github.com/llvm/llvm-project/pull/204635
More information about the flang-commits
mailing list