re PR fortran/89077 (ICE using * as len specifier for character parameter)

2019-02-09  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/89077
	* resolve.c (gfc_resolve_substring_charlen): Check substring
	length for constantness prior to general calculation of length.

	PR fortran/89077
	* gfortran.dg/substr_simplify.f90: New test.

From-SVN: r268726

4 files changed, 51 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 96cb70e..b5a4c0a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-02-09  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/89077
+	* resolve.c (gfc_resolve_substring_charlen): Check substring
+	length for constantness prior to general calculation of length.
+
 2019-02-09  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/89200
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 92d27fc..3a8f402 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4965,6 +4965,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   gfc_ref *char_ref;
   gfc_expr *start, *end;
   gfc_typespec *ts = NULL;
+  mpz_t diff;
 
   for (char_ref = e->ref; char_ref; char_ref = char_ref->next)
     {
@@ -5016,11 +5017,25 @@ gfc_resolve_substring_charlen (gfc_expr *e)
       return;
     }
 
-  /* Length = (end - start + 1).  */
-  e->ts.u.cl->length = gfc_subtract (end, start);
-  e->ts.u.cl->length = gfc_add (e->ts.u.cl->length,
-				gfc_get_int_expr (gfc_charlen_int_kind,
-						  NULL, 1));
+  /* Length = (end - start + 1).
+     Check first whether it has a constant length.  */
+  if (gfc_dep_difference (end, start, &diff))
+    {
+      gfc_expr *len = gfc_get_constant_expr (BT_INTEGER, gfc_charlen_int_kind,
+					     &e->where);
+
+      mpz_add_ui (len->value.integer, diff, 1);
+      mpz_clear (diff);
+      e->ts.u.cl->length = len;
+      /* The check for length < 0 is handled below */
+    }
+  else
+    {
+      e->ts.u.cl->length = gfc_subtract (end, start);
+      e->ts.u.cl->length = gfc_add (e->ts.u.cl->length,
+				    gfc_get_int_expr (gfc_charlen_int_kind,
+						      NULL, 1));
+    }
 
   /* F2008, 6.4.1:  Both the starting point and the ending point shall
      be within the range 1, 2, ..., n unless the starting point exceeds
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 31e275a..c0af043 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-02-09  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/89077
+	* gfortran.dg/substr_simplify.f90: New test.
+
 2019-02-09  Jan Hubicka  <hubicka@ucw.cz>
 
 	PR ipa/88711
diff --git a/gcc/testsuite/gfortran.dg/substr_simplify.f90 b/gcc/testsuite/gfortran.dg/substr_simplify.f90
new file mode 100644
index 0000000..7e1e1c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/substr_simplify.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+!
+! Test fixes for substring simplications derived from
+! PR fortran/89077 - ICE using * as len specifier for character parameter
+
+program test
+  implicit none
+  integer :: i
+  character(*), parameter :: s = 'abcdef', y = 'efcdab'
+  character(6), save      :: t = transfer ([(s(i:i),  i=1,len(s)  )], s)
+  character(*), parameter :: u = transfer ([(s(i:i+2),i=1,len(s),3)], s)
+  character(6), save      :: v = transfer ([(s(i:i+2),i=1,len(s),3)], s)
+  character(*), parameter :: w = transfer ([(y(i:i+1),i=len(s)-1,1,-2)], s)
+  character(6), save      :: x = transfer ([(y(i:i+1),i=len(s)-1,1,-2)], s)
+  if (len (t) /= len (s) .or. t /= s) stop 1
+  if (len (u) /= len (s) .or. u /= s) stop 2
+  if (len (v) /= len (s) .or. v /= s) stop 3
+  if (len (w) /= len (s) .or. w /= s) stop 4
+  if (len (x) /= len (s) .or. x /= s) stop 5
+end