===================================================================
@@ -697,8 +697,7 @@ char_len_param_value (gfc_expr **expr, b
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, b
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, b
}
}
}
+
+ /* 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
{
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
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_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,22 +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.
-CHARACTER(len=0) :: c1 ! This is OK.
-CHARACTER(len=-1) :: c2 ! { dg-warning "has negative length" }
+! { dg-do compile }
+! Original test came in with fix for PR 31250.
+! The last line tests the fix for PR fortran/67987.
+!
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=max(I,500)) :: d1 ! no warning
-CHARACTER(len=5) :: d2 ! no warning
-
-if (len(c1) .ne. 0) call link_error ()
-if (len(c2) .ne. len(c1)) call link_error ()
-if (len(c3) .ne. len(c2)) call link_error ()
-if (len(c4) .ne. len(c3)) call link_error ()
-
-if (len(d1) .ne. 500) call link_error ()
-if (len(d2) .ne. 5) call link_error ()
+CHARACTER(len=0) :: c1
+CHARACTER(len=-1) :: c2
+CHARACTER(len=I) :: c3
+CHARACTER(len=min(I,500)) :: c4
+CHARACTER(len=max(I,500)) :: d1
+CHARACTER(len=5) :: d2
+character(-8) :: c = ' '
END