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
This commit is contained in:
parent
767dc529b7
commit
98a819ea15
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
Loading…
Reference in New Issue