re PR fortran/67987 (ICE on declaring and initializing character with negative len)

2015-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67987
	* decl.c (char_len_param_value): Unwrap unlong line.  If LEN < 0,
	force it to zero per the Fortran 90, 95, 2003, and 2008 Standards.
	* resolve.c (gfc_resolve_substring_charlen): Unwrap unlong line.
	If 'start' is larger than 'end', length of substring is negative,
	so explicitly set it to zero.
	(resolve_charlen): Remove -Wsurprising warning.  Update comment to
	reflect that the text is from the F2008 standard.

2015-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67987
	* gfortran.df/pr67987.f90: New test.
	* gfortran.dg/char_length_2.f90: Update testcase.

From-SVN: r228933

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6a89d33248b092aaf307087e16575f5d099e7ce7..9c5bb766c9b81f2eb7f5d487696808533d13621f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2015-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/67987
+       * decl.c (char_len_param_value): Unwrap unlong line.  If LEN < 0,
+       force it to zero per the Fortran 90, 95, 2003, and 2008 Standards. 
+       * resolve.c (gfc_resolve_substring_charlen): Unwrap unlong line.
+       If 'start' is larger than 'end', length of substring is negative,
+       so explicitly set it to zero.
+       (resolve_charlen): Remove -Wsurprising warning.  Update comment to
+       reflect that the text is from the F2008 standard.
+
 2015-10-16  Richard Biener  <rguenther@suse.de>
 
        * trans-intrinsic.c (gfc_conv_intrinsic_lib_function): Adjust

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 39e08055582f48874ad072f8935d84fe9017fdf9..4871b7c364e10a0301580383c6ce3d2049a437cf 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -697,8 +697,7 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
 
   if (gfc_match_char (':') == MATCH_YES)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "deferred type "
-                          "parameter at %C"))
+      if (!gfc_notify_std (GFC_STD_F2003, "deferred type parameter at %C"))
        return MATCH_ERROR;
 
       *deferred = true;
@@ -708,11 +707,13 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
 
   m = gfc_match_expr (expr);
 
-  if (m == MATCH_YES
-      && !gfc_expr_check_typed (*expr, gfc_current_ns, false))
+  if (m == MATCH_NO || m == MATCH_ERROR)
+    return m;
+
+  if (!gfc_expr_check_typed (*expr, gfc_current_ns, false))
     return MATCH_ERROR;
 
-  if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION)
+  if ((*expr)->expr_type == EXPR_FUNCTION)
     {
       if ((*expr)->value.function.actual
          && (*expr)->value.function.actual->expr->symtree)
@@ -731,6 +732,15 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
            }
        }
     }
+
+  /* F2008, 4.4.3.1:  The length is a type parameter; its kind is processor
+     dependent and its value is greater than or equal to zero.
+     F2008, 4.4.3.2:  If the character length parameter value evaluates to
+     a negative value, the length of character entities declared is zero.  */
+  if ((*expr)->expr_type == EXPR_CONSTANT
+      && mpz_cmp_si ((*expr)->value.integer, 0) < 0)
+    mpz_set_si ((*expr)->value.integer, 0);
+
   return m;
 
 syntax:

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 50b5c1d2a330cab14ec9557f850bb6b4b2336733..491507b0cee72f19d5d647a16f234de14ecce761 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4562,8 +4562,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
     {
       if (e->ts.u.cl->length)
        gfc_free_expr (e->ts.u.cl->length);
-      else if (e->expr_type == EXPR_VARIABLE
-                && e->symtree->n.sym->attr.dummy)
+      else if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.dummy)
        return;
     }
 
@@ -4596,12 +4595,19 @@ gfc_resolve_substring_charlen (gfc_expr *e)
       return;
     }
 
-  /* Length = (end - start +1).  */
+  /* 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_default_integer_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
+     the ending point, in which case the substring has length zero.  */
+
+  if (mpz_cmp_si (e->ts.u.cl->length->value.integer, 0) < 0)
+    mpz_set_si (e->ts.u.cl->length->value.integer, 0);
+
   e->ts.u.cl->length->ts.type = BT_INTEGER;
   e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
 
@@ -10882,18 +10888,11 @@ resolve_charlen (gfc_charlen *cl)
        }
     }
 
-  /* "If the character length parameter value evaluates to a negative
-     value, the length of character entities declared is zero."  */
+  /* F2008, 4.4.3.2:  If the character length parameter value evaluates to
+     a negative value, the length of character entities declared is zero.  */
   if (cl->length && !gfc_extract_int (cl->length, &i) && i < 0)
-    {
-      if (warn_surprising)
-       gfc_warning_now (OPT_Wsurprising,
-                        "CHARACTER variable at %L has negative length %d,"
-                        " the length has been set to zero",
-                        &cl->length->where, i);
-      gfc_replace_expr (cl->length,
-                       gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
-    }
+    gfc_replace_expr (cl->length,
+                     gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
 
   /* Check that the character length is not too large.  */
   k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 90a2c66865b0b903a7b49001281b93a7dc4fd02e..b12db829324a0fb26b0c8c5eb10f116b8705f5df 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2015-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/67987
+       * gfortran.df/pr67987.f90: New test.
+       * gfortran.dg/char_length_2.f90: Update testcase.
+
 2015-10-16  H.J. Lu  <hongjiu.lu@intel.com>
 
        * gcc.target/i386/iamcu/test_basic_returning.c

diff --git a/gcc/testsuite/gfortran.dg/char_length_2.f90 b/gcc/testsuite/gfortran.dg/char_length_2.f90
index 5673a2ed582f3da50181b9e19b27fc9c1e097268..f35c9b562172bdfed8375ad234ab3c83c67d4e2f 100644 (file)
--- a/gcc/testsuite/gfortran.dg/char_length_2.f90
+++ b/gcc/testsuite/gfortran.dg/char_length_2.f90
@@ -1,14 +1,13 @@
-! { dg-do link }
-! { dg-options "-Wsurprising" }
-! Tests the fix for PR 31250
-! CHARACTER lengths weren't reduced early enough for all checks of
-! them to be meaningful.  Furthermore negative string lengths weren't
-! dealt with correctly.
+! { dg-do compile }
+! Tests the fix for PR 31250.
+! The fix for PR fortran/67987 supercedes PR 31250, which removes
+! the -Wsurprising option.
+!
 CHARACTER(len=0) :: c1   ! This is OK.
-CHARACTER(len=-1) :: c2  ! { dg-warning "has negative length" }
+CHARACTER(len=-1) :: c2
 PARAMETER(I=-100)
-CHARACTER(len=I) :: c3   ! { dg-warning "has negative length" }
-CHARACTER(len=min(I,500)) :: c4  ! { dg-warning "has negative length" }
+CHARACTER(len=I) :: c3
+CHARACTER(len=min(I,500)) :: c4
 CHARACTER(len=max(I,500)) :: d1  ! no warning
 CHARACTER(len=5) :: d2   ! no warning
 

diff --git a/gcc/testsuite/gfortran.dg/pr67987.f90 b/gcc/testsuite/gfortran.dg/pr67987.f90
new file mode 100644 (file)
index 0000000..1d57f9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr67987.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR fortran/67987
+! PR fortran/67988
+! Original code contributed by Gerhard Steinmetz
+! gerhard dot steinmetz dot fortran at t-online dot de
+subroutine p
+   character(-8) :: c = ' '
+end subroutine p
+
+subroutine pp
+   character(3), parameter :: c = 'abc'
+   character(3) :: x(1)
+   x = c(:-2)
+   print *, len(trim(x(1)))
+   x = [ c(:-2) ]
+   print *, len(trim(x(1)))
+end subroutine pp
+