diff mbox series

Fortran: implement vector sections in DATA statements [PR49588]

Message ID trinity-465e9c23-c45c-40b4-b023-d80400782239-1692647313365@3c-app-gmx-bs15
State Accepted
Headers
Series Fortran: implement vector sections in DATA statements [PR49588] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Harald Anlauf Aug. 21, 2023, 7:48 p.m. UTC 
  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

Comments

Paul Richard Thomas Aug. 22, 2023, 6:32 a.m. UTC | #1 
Hi Harald,

It all looks good to me and does indeed make the code clearer. OK for trunk.

Thanks for the patch.

I was shocked to find that there are 217 older bugs than 49588. Does
anybody test older bugs to check if any of them have been fixed?

Paul

On Mon, 21 Aug 2023 at 20:48, Harald Anlauf via Fortran
<fortran@gcc.gnu.org> wrote:
>
> 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
>
Harald Anlauf Aug. 22, 2023, 6:45 p.m. UTC | #2 
Hi Paul,

Am 22.08.23 um 08:32 schrieb Paul Richard Thomas via Gcc-patches:
> Hi Harald,
>
> It all looks good to me and does indeed make the code clearer. OK for trunk.
>
> Thanks for the patch.

thanks for the review!

> I was shocked to find that there are 217 older bugs than 49588. Does
> anybody test older bugs to check if any of them have been fixed?

I am not aware of this being done systematically.

At the same time, we have over 100 PRs marked as regression,
with a few being fixed on mainline but not backported (or
undecided whether to backport).  Fixing and/or closing them
might be low-hanging fruits.

There are also far more than 100 TODOs in gcc/fortran/*.cc ...

And with the usual PRs, there's enough work left for all kinds
of contributions.

Cheers,
Harald

> Paul
>
> On Mon, 21 Aug 2023 at 20:48, Harald Anlauf via Fortran
> <fortran@gcc.gnu.org> wrote:
>>
>> 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
>>
>
diff mbox series

Patch

From 96cc0333cdaa8459ef516ae8e74158cdb6302853 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
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");
+		  mpz_set (section_index[i], start->value.integer);
+		  gfc_free_expr(start);
+		}
+	      else
+		mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+	      advance = true;
+	    }
+	  break;
+
+	case DIMEN_VECTOR:
+	  vector_offset[i]++;
+	  base = ar->start[i]->value.constructor;
+	  elem = gfc_constructor_lookup_expr (base, vector_offset[i]);
+
+	  if (elem == NULL)
+	    {
+	      /* Reset to first vector element and advance the next index.  */
+	      vector_offset[i] = 0;
+	      elem = gfc_constructor_lookup_expr (base, 0);
+	      advance = true;
+	    }
+	  if (elem)
+	    {
+	      start = gfc_copy_expr (elem);
+	      if (!gfc_simplify_expr (start, 1))
+		gfc_internal_error ("Simplification error");
 	      mpz_set (section_index[i], start->value.integer);
-	      gfc_free_expr(start);
+	      gfc_free_expr (start);
 	    }
-	  else
-	    mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+	  break;
+
+	default:
+	  gcc_unreachable ();
 	}
-      else
+
+      if (!advance)
 	break;
     }

@@ -793,12 +830,14 @@  gfc_formalize_init_value (gfc_symbol *sym)
    offset.  */

 void
-gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
+gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset,
+		       int *vector_offset)
 {
   int i;
   mpz_t delta;
   mpz_t tmp;
-  gfc_expr *start;
+  gfc_expr *start, *elem;
+  gfc_constructor_base base;

   mpz_set_si (*offset, 0);
   mpz_init (tmp);
@@ -810,29 +849,35 @@  gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
 	{
 	case DIMEN_ELEMENT:
 	case DIMEN_RANGE:
-	  if (ar->start[i])
-	    {
-	      start = gfc_copy_expr(ar->start[i]);
-	      if(!gfc_simplify_expr(start, 1))
-	        gfc_internal_error("Simplification error");
-	      mpz_sub (tmp, start->value.integer,
-		       ar->as->lower[i]->value.integer);
-	      mpz_mul (tmp, tmp, delta);
-	      mpz_add (*offset, tmp, *offset);
-	      mpz_set (section_index[i], start->value.integer);
-	      gfc_free_expr(start);
-	    }
-	  else
-	      mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+	  elem = ar->start[i];
 	  break;

 	case DIMEN_VECTOR:
-	  gfc_internal_error ("TODO: Vector sections in data statements");
+	  vector_offset[i] = 0;
+	  base = ar->start[i]->value.constructor;
+	  elem = gfc_constructor_lookup_expr (base, vector_offset[i]);
+	  break;

 	default:
 	  gcc_unreachable ();
 	}

+      if (elem)
+	{
+	  start = gfc_copy_expr (elem);
+	  if (!gfc_simplify_expr (start, 1))
+	    gfc_internal_error ("Simplification error");
+	  mpz_sub (tmp, start->value.integer,
+		   ar->as->lower[i]->value.integer);
+	  mpz_mul (tmp, tmp, delta);
+	  mpz_add (*offset, tmp, *offset);
+	  mpz_set (section_index[i], start->value.integer);
+	  gfc_free_expr (start);
+	}
+      else
+	/* Fallback for empty section or constructor.  */
+	mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+
       mpz_sub (tmp, ar->as->upper[i]->value.integer,
 	       ar->as->lower[i]->value.integer);
       mpz_add_ui (tmp, tmp, 1);
diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h
index 40dbee1ef28..8f2013ac894 100644
--- a/gcc/fortran/data.h
+++ b/gcc/fortran/data.h
@@ -18,6 +18,6 @@  along with GCC; see the file COPYING3.  If not see
 <http://www.gnu.org/licenses/>.  */

 void gfc_formalize_init_value (gfc_symbol *);
-void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
+void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *, int *);
 bool gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
-void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
+void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *, int *);
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f51674f7faa..ce8261d646a 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -16765,6 +16765,7 @@  check_data_variable (gfc_data_variable *var, locus *where)
   ar_type mark = AR_UNKNOWN;
   int i;
   mpz_t section_index[GFC_MAX_DIMENSIONS];
+  int vector_offset[GFC_MAX_DIMENSIONS];
   gfc_ref *ref;
   gfc_array_ref *ar;
   gfc_symbol *sym;
@@ -16888,7 +16889,7 @@  check_data_variable (gfc_data_variable *var, locus *where)
 	case AR_SECTION:
 	  ar = &ref->u.ar;
 	  /* Get the start position of array section.  */
-	  gfc_get_section_index (ar, section_index, &offset);
+	  gfc_get_section_index (ar, section_index, &offset, vector_offset);
 	  mark = AR_SECTION;
 	  break;

@@ -16971,7 +16972,7 @@  check_data_variable (gfc_data_variable *var, locus *where)
 	  /* Modify the array section indexes and recalculate the offset
 	     for next element.  */
 	  else if (mark == AR_SECTION)
-	    gfc_advance_section (section_index, ar, &offset);
+	    gfc_advance_section (section_index, ar, &offset, vector_offset);
 	}
     }

diff --git a/gcc/testsuite/gfortran.dg/data_vector_section.f90 b/gcc/testsuite/gfortran.dg/data_vector_section.f90
new file mode 100644
index 00000000000..3e099de99d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_vector_section.f90
@@ -0,0 +1,26 @@ 
+! { dg-do run }
+! PR fortran/49588 - vector sections in data statements
+
+block data
+  implicit none
+  integer :: a(8), b(3,2), i
+  data a(::2)   /4*1/
+  data a([2,6]) /2*2/
+  data a([4])   /3/
+  data a([(6+2*i,i=1,1)]) /1*5/
+  data b( 1   ,[1,2]) /11,12/
+  data b([2,3],[2,1]) /22,32,21,31/
+  common /com/ a, b
+end block data
+
+program test
+  implicit none
+  integer :: a(8), b(3,2), i, j
+  common /com/ a, b
+  print *, a
+  print *, b
+! print *, a - [1,2,1,3,1,2,1,5]
+! print *, ((b(i,j)-(10*i+j),i=1,3),j=1,2)
+  if (.not. all (a == [1,2,1,3,1,2,1,5])) stop 1
+  if (.not. all (b == reshape ([((10*i+j,i=1,3),j=1,2)], shape (b)))) stop 2
+end program test
--
2.35.3