re PR fortran/31250 (Initialization expr as constant character length rejected)

PR fortran/31250
fortran/
* decl.c (match_char_spec): Move check for negative CHARACTER
length ...
* resolve.c (resolve_charlen): ... here.
(resolve_types): Resolve CHARACTER lengths earlier.
teststuite/
* gfortran.dg/char_length_2.f90: New.

From-SVN: r123763
This commit is contained in:
Tobias Schlüter 2007-04-12 20:48:06 +02:00
parent c6214a7507
commit 5cd09fac3d
5 changed files with 48 additions and 13 deletions

View File

@ -1,3 +1,11 @@
2007-04-12 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/31250
* decl.c (match_char_spec): Move check for negative CHARACTER
length ...
* resolve.c (resolve_charlen): ... here.
(resolve_types): Resolve CHARACTER lengths earlier.
2007-04-12 Daniel Franke <franke.daniel@gmail.com>
PR fortran/31234

View File

@ -1515,7 +1515,7 @@ no_match:
static match
match_char_spec (gfc_typespec *ts)
{
int i, kind, seen_length;
int kind, seen_length;
gfc_charlen *cl;
gfc_expr *len;
match m;
@ -1646,15 +1646,7 @@ done:
if (seen_length == 0)
cl->length = gfc_int_expr (1);
else
{
if (len == NULL || gfc_extract_int (len, &i) != NULL || i >= 0)
cl->length = len;
else
{
gfc_free_expr (len);
cl->length = gfc_int_expr (0);
}
}
cl->length = len;
ts->cl = cl;
ts->kind = kind;

View File

@ -5389,6 +5389,8 @@ resolve_index_expr (gfc_expr *e)
static try
resolve_charlen (gfc_charlen *cl)
{
int i;
if (cl->resolved)
return SUCCESS;
@ -5402,6 +5404,15 @@ resolve_charlen (gfc_charlen *cl)
return FAILURE;
}
/* "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)
{
gfc_warning_now ("CHARACTER variable has zero length at %L",
&cl->length->where);
gfc_replace_expr (cl->length, gfc_int_expr (0));
}
return SUCCESS;
}
@ -7270,6 +7281,9 @@ resolve_types (gfc_namespace *ns)
resolve_contained_functions (ns);
for (cl = ns->cl_list; cl; cl = cl->next)
resolve_charlen (cl);
gfc_traverse_ns (ns, resolve_symbol);
resolve_fntype (ns);
@ -7287,9 +7301,6 @@ resolve_types (gfc_namespace *ns)
forall_flag = 0;
gfc_check_interfaces (ns);
for (cl = ns->cl_list; cl; cl = cl->next)
resolve_charlen (cl);
gfc_traverse_ns (ns, resolve_values);
if (ns->save_all)

View File

@ -1,5 +1,8 @@
2007-04-12 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/31250
* gfortran.dg/char_length_2.f90: New.
PR fortran/31266
* gfortran.dg/char_assign_1.f90: New.

View File

@ -0,0 +1,21 @@
! { dg-do link }
! 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 ! { dg-warning "CHARACTER variable has zero length" }
CHARACTER(len=-1) :: c2 ! { dg-warning "CHARACTER variable has zero length" }
PARAMETER(I=-100)
CHARACTER(len=I) :: c3 ! { dg-warning "CHARACTER variable has zero length" }
CHARACTER(len=min(I,500)) :: c4 ! { dg-warning "CHARACTER variable has zero 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 ()
END