From 34bf7ba5777c0f0f2b09473ec4db609bf772daa9 Mon Sep 17 00:00:00 2001 From: kargl Date: Sat, 17 Oct 2015 16:50:47 +0000 Subject: [PATCH] 2015-10-17 Steven G. Kargl 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 PR fortran/67987 * gfortran.df/pr67987.f90: New test. * gfortran.dg/char_length_2.f90: Update testcase. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@228933 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/decl.c | 20 +++++++++++++++----- gcc/fortran/resolve.c | 27 +++++++++++++-------------- gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/char_length_2.f90 | 17 ++++++++--------- gcc/testsuite/gfortran.dg/pr67987.f90 | 18 ++++++++++++++++++ 6 files changed, 71 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr67987.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6a89d33248b..9c5bb766c9b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2015-10-17 Steven G. Kargl + + 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 * trans-intrinsic.c (gfc_conv_intrinsic_lib_function): Adjust diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 39e08055582..4871b7c364e 100644 --- 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 50b5c1d2a33..491507b0cee 100644 --- 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 90a2c66865b..b12db829324 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-10-17 Steven G. Kargl + + PR fortran/67987 + * gfortran.df/pr67987.f90: New test. + * gfortran.dg/char_length_2.f90: Update testcase. + 2015-10-16 H.J. Lu * 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 5673a2ed582..f35c9b56217 100644 --- 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 index 00000000000..1d57f9bda06 --- /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 + -- 2.11.4.GIT