diff mbox series

[RFC] PR fortran/93340 - [8/9/10/11 Regression] fix missed substring simplifications

Message ID trinity-a673fed8-4130-432c-9a3d-c376bd134b1f-1610488977905@3c-app-gmx-bap11
State New
Headers show
Series [RFC] PR fortran/93340 - [8/9/10/11 Regression] fix missed substring simplifications | expand

Commit Message

Harald Anlauf Jan. 12, 2021, 10:02 p.m. UTC 
Dear all,

when playing around with the issues exposed by PR93340, particularly visible
in the tree dump, I tried to find ways to simplify substrings in those cases
where they are eligible as designator, which is required e.g. in DATA statements.

Given my limited understanding, I finally arrived at a potential solution which
does that simplification near the end of match_string_constant in primary.c.
I couldn't find a better place, but I am open to better suggestions.

The simplification below does an even better job at detecting invalid substring
starting or ending indices than HEAD, and regtests cleanly on x86_64-pc-linux-gnu.

Feedback appreciated.  Is this potentially ok for master, or should this be done
differently?

Thanks,
Harald


PR fortran/93340 - fix missed substring simplifications

Substrings were not reduced early enough for use in initializations,
such as DATA statements.  Add an early simplification for substrings
with constant starting and ending points.

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_resolve_substring): Add prototype.
	* primary.c (match_string_constant): Simplify substrings with
	constant starting and ending points.
	* resolve.c: Rename resolve_substring to gfc_resolve_substring.
	(gfc_resolve_ref): Use renamed function gfc_resolve_substring.

gcc/testsuite/ChangeLog:

	* substr_10.f90: New test.
	* substr_9.f90: New test.

Comments

Paul Richard Thomas Jan. 14, 2021, 6:11 p.m. UTC | #1 
Hi Harald,

It looks OK to me. I can see why you are asking about the implementation
but cannot offer a better solution.

OK for master.

Thanks

Paul


On Tue, 12 Jan 2021 at 22:03, Harald Anlauf via Fortran <fortran@gcc.gnu.org>
wrote:

> Dear all,
>
> when playing around with the issues exposed by PR93340, particularly
> visible
> in the tree dump, I tried to find ways to simplify substrings in those
> cases
> where they are eligible as designator, which is required e.g. in DATA
> statements.
>
> Given my limited understanding, I finally arrived at a potential solution
> which
> does that simplification near the end of match_string_constant in
> primary.c.
> I couldn't find a better place, but I am open to better suggestions.
>
> The simplification below does an even better job at detecting invalid
> substring
> starting or ending indices than HEAD, and regtests cleanly on
> x86_64-pc-linux-gnu.
>
> Feedback appreciated.  Is this potentially ok for master, or should this
> be done
> differently?
>
> Thanks,
> Harald
>
>
> PR fortran/93340 - fix missed substring simplifications
>
> Substrings were not reduced early enough for use in initializations,
> such as DATA statements.  Add an early simplification for substrings
> with constant starting and ending points.
>
> gcc/fortran/ChangeLog:
>
>         * gfortran.h (gfc_resolve_substring): Add prototype.
>         * primary.c (match_string_constant): Simplify substrings with
>         constant starting and ending points.
>         * resolve.c: Rename resolve_substring to gfc_resolve_substring.
>         (gfc_resolve_ref): Use renamed function gfc_resolve_substring.
>
> gcc/testsuite/ChangeLog:
>
>         * substr_10.f90: New test.
>         * substr_9.f90: New test.
>
>
diff mbox series

Patch

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6585e4f3ecd..4dd72b620c9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3467,6 +3467,7 @@  bool find_forall_index (gfc_expr *, gfc_symbol *, int);
 bool gfc_resolve_index (gfc_expr *, int);
 bool gfc_resolve_dim_arg (gfc_expr *);
 bool gfc_is_formal_arg (void);
+bool gfc_resolve_substring (gfc_ref *, bool *);
 void gfc_resolve_substring_charlen (gfc_expr *);
 match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index db9ecf9a4f6..7cb378e3090 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1190,6 +1190,61 @@  got_delim:
   if (match_substring (NULL, 0, &e->ref, false) != MATCH_NO)
     e->expr_type = EXPR_SUBSTRING;

+  /* Substrings with constant starting and ending points are eligible as
+     designators (F2018, section 9.1).  Simplify substrings to make them usable
+     e.g. in data statements.  */
+  if (e->expr_type == EXPR_SUBSTRING
+      && e->ref && e->ref->type == REF_SUBSTRING
+      && e->ref->u.ss.start->expr_type == EXPR_CONSTANT
+      && (e->ref->u.ss.end == NULL
+	  || e->ref->u.ss.end->expr_type == EXPR_CONSTANT))
+    {
+      gfc_expr *res;
+      ptrdiff_t istart, iend;
+      size_t length;
+      bool equal_length = false;
+
+      /* Basic checks on substring  starting and ending indices.  */
+      if (!gfc_resolve_substring (e->ref, &equal_length))
+	return MATCH_ERROR;
+
+      length = e->value.character.length;
+      istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer);
+      if (e->ref->u.ss.end == NULL)
+	iend = length;
+      else
+	iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer);
+
+      if (istart <= iend)
+	{
+	  if (istart < 1)
+	    {
+	      gfc_error ("Substring start index (%ld) at %L below 1",
+			 (long) istart, &e->ref->u.ss.start->where);
+	      return MATCH_ERROR;
+	    }
+	  if (iend > (ssize_t) length)
+	    {
+	      gfc_error ("Substring end index (%ld) at %L exceeds string "
+			 "length", (long) iend, &e->ref->u.ss.end->where);
+	      return MATCH_ERROR;
+	    }
+	  length = iend - istart + 1;
+	}
+      else
+	length = 0;
+
+      res = gfc_get_constant_expr (BT_CHARACTER, e->ts.kind, &e->where);
+      res->value.character.string = gfc_get_wide_string (length + 1);
+      res->value.character.length = length;
+      if (length > 0)
+	memcpy (res->value.character.string,
+		&e->value.character.string[istart - 1],
+		length * sizeof (gfc_char_t));
+      res->value.character.string[length] = '\0';
+      e = res;
+    }
+
   *result = e;

   return MATCH_YES;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f243bd185b0..3929ddff849 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5068,8 +5068,8 @@  resolve_array_ref (gfc_array_ref *ar)
 }


-static bool
-resolve_substring (gfc_ref *ref, bool *equal_length)
+bool
+gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
 {
   int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);

@@ -5277,7 +5277,7 @@  gfc_resolve_ref (gfc_expr *expr)

       case REF_SUBSTRING:
 	equal_length = false;
-	if (!resolve_substring (*prev, &equal_length))
+	if (!gfc_resolve_substring (*prev, &equal_length))
 	  return false;

 	if (expr->expr_type != EXPR_SUBSTRING && equal_length)
diff --git a/gcc/testsuite/substr_10.f90 b/gcc/testsuite/substr_10.f90
new file mode 100644
index 00000000000..918ca8af162
--- /dev/null
+++ b/gcc/testsuite/substr_10.f90
@@ -0,0 +1,11 @@ 
+! { dg-do compile }
+! PR93340 - test error handling of substring simplification
+
+subroutine p
+  integer,parameter :: k = len ('a'(:0))
+  integer,parameter :: m = len ('a'(0:)) ! { dg-error "Substring start index" }
+  call foo ('bcd'(-8:-9))
+  call foo ('bcd'(-9:-8)) ! { dg-error "Substring start index" }
+  call foo ('bcd'(:12))   ! { dg-error "Substring end index" }
+  call foo ('bcd'(-12:))  ! { dg-error "Substring start index" }
+end
diff --git a/gcc/testsuite/substr_9.f90 b/gcc/testsuite/substr_9.f90
new file mode 100644
index 00000000000..73152d6627f
--- /dev/null
+++ b/gcc/testsuite/substr_9.f90
@@ -0,0 +1,28 @@ 
+! { dg-do run }
+! { dg-options "-std=gnu -fdump-tree-original" }
+! PR93340 - issues with substrings in initializers
+
+program p
+  implicit none
+  integer, parameter :: m = 1
+  character b(2) /'a', 'b'   (1:1)/
+  character c(2) /'a', 'bc'  (1:1)/
+  character d(2) /'a', 'bxyz'(m:m)/
+  character e(2)
+  character f(2)
+  data e /'a', 'bxyz'( :1)/
+  data f /'a', 'xyzb'(4:4)/
+  character :: g(2) = [ 'a', 'b' (1:1) ]
+  character :: h(2) = [ 'a', 'bc'(1:1) ]
+  character :: k(2) = [ 'a', 'bc'(m:1) ]
+  if (b(2) /= "b") stop 1
+  if (c(2) /= "b") stop 2
+  if (d(2) /= "b") stop 3
+  if (e(2) /= "b") stop 4
+  if (f(2) /= "b") stop 5
+  if (g(2) /= "b") stop 6
+  if (h(2) /= "b") stop 7
+  if (k(2) /= "b") stop 8
+end
+
+! { dg-final { scan-tree-dump-times "xyz" 0 "original" } }