Dear all,
the attached patch implements vector sections in DATA statements.
The implementation is simpler than the size of the patch suggests,
as part of changes try to clean up the existing code to make it
easier to understand, as ordinary sections (start:end:stride)
and vector sections may actually share some common code.
The basisc idea of the implementation is that one needs a
temporary vector that keeps track of the offsets into the
array constructors for the indices in the array reference
that are vectors.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 96cc0333cdaa8459ef516ae8e74158cdb6302853 Mon Sep 17 00:00:00 2001
From: Harald Anlauf
Date: Mon, 21 Aug 2023 21:23:57 +0200
Subject: [PATCH] Fortran: implement vector sections in DATA statements
[PR49588]
gcc/fortran/ChangeLog:
PR fortran/49588
* data.cc (gfc_advance_section): Derive next index set and next offset
into DATA variable also for array references using vector sections.
Use auxiliary array to keep track of offsets into indexing vectors.
(gfc_get_section_index): Set up initial indices also for DATA variables
with array references using vector sections.
* data.h (gfc_get_section_index): Adjust prototype.
(gfc_advance_section): Likewise.
* resolve.cc (check_data_variable): Pass vector offsets.
gcc/testsuite/ChangeLog:
PR fortran/49588
* gfortran.dg/data_vector_section.f90: New test.
---
gcc/fortran/data.cc | 161 +++---
gcc/fortran/data.h| 4 +-
gcc/fortran/resolve.cc| 5 +-
.../gfortran.dg/data_vector_section.f90 | 26 +++
4 files changed, 134 insertions(+), 62 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/data_vector_section.f90
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index d29eb12c1b1..7c2537dd3f0 100644
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -634,65 +634,102 @@ abort:
void
gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
- mpz_t *offset_ret)
+ mpz_t *offset_ret, int *vector_offset)
{
int i;
mpz_t delta;
mpz_t tmp;
bool forwards;
int cmp;
- gfc_expr *start, *end, *stride;
+ gfc_expr *start, *end, *stride, *elem;
+ gfc_constructor_base base;
for (i = 0; i < ar->dimen; i++)
{
- if (ar->dimen_type[i] != DIMEN_RANGE)
- continue;
+ bool advance = false;
- if (ar->stride[i])
+ switch (ar->dimen_type[i])
{
- stride = gfc_copy_expr(ar->stride[i]);
- if(!gfc_simplify_expr(stride, 1))
- gfc_internal_error("Simplification error");
- mpz_add (section_index[i], section_index[i],
- stride->value.integer);
- if (mpz_cmp_si (stride->value.integer, 0) >= 0)
- forwards = true;
+ case DIMEN_ELEMENT:
+ /* Loop to advance the next index. */
+ advance = true;
+ break;
+
+ case DIMEN_RANGE:
+ if (ar->stride[i])
+ {
+ stride = gfc_copy_expr(ar->stride[i]);
+ if(!gfc_simplify_expr(stride, 1))
+ gfc_internal_error("Simplification error");
+ mpz_add (section_index[i], section_index[i],
+ stride->value.integer);
+ if (mpz_cmp_si (stride->value.integer, 0) >= 0)
+ forwards = true;
+ else
+ forwards = false;
+ gfc_free_expr(stride);
+ }
else
- forwards = false;
- gfc_free_expr(stride);
- }
- else
- {
- mpz_add_ui (section_index[i], section_index[i], 1);
- forwards = true;
- }
+ {
+ mpz_add_ui (section_index[i], section_index[i], 1);
+ forwards = true;
+ }
- if (ar->end[i])
-{
- end = gfc_copy_expr(ar->end[i]);
- if(!gfc_simplify_expr(end, 1))
- gfc_internal_error("Simplification error");
- cmp = mpz_cmp (section_index[i], end->value.integer);
- gfc_free_expr(end);
- }
- else
- cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
+ if (ar->end[i])
+ {
+ end = gfc_copy_expr(ar->end[i]);
+ if(!gfc_simplify_expr(end, 1))
+ gfc_internal_error("Simplification error");
+ cmp = mpz_cmp (section_index[i], end->value.integer);
+ gfc_free_expr(end);
+ }
+ else
+ cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
- if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
- {
- /* Reset index to start, then loop to advance the next index. */
- if (ar->start[i])
+ if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
{
- start = gfc_copy_expr(ar->start[i]);
- if(!gfc_simplify_expr(start, 1))
- gfc_internal_error("Simplification error");
+ /* Reset index to start, then loop to advance the next index. */
+ if (ar->start[i])
+ {
+ start = gfc_copy_expr(ar->start[i]);
+ if(!gfc_simplify_expr(start, 1))
+ gfc_internal_error("Simplification error&
