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.

(cherry picked from commit bdd1b1f55529da00b867ef05a53a08fbfc3d1c2e)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c2c3d880f5b5532d5547d0092370fe1605c07aba..ad689e6a50910c84629eb61f65d3374cf50fac44 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3359,6 +3359,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 6c7e4435ab82486b4d54acbd3e155dbe69b11e6e..cbd84bb0abcb9b6fe6bffd75e67eb55554ee9fcd 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1151,6 +1151,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 764020cfe094b6b3ea4ef2b35624330ead4c1714..093402d89164932bb7b80650405c5ca6fef4028f 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4910,8 +4910,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);
 
@@ -5122,7 +5122,7 @@ 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 (file)
index 0000000..918ca8a
--- /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 (file)
index 0000000..73152d6
--- /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" } }