diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 28e2d16716e..fe6b13997d3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-04-12 Tobias Schlüter + + 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 PR fortran/31234 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 43e0235facd..9b54bcab10b 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 467ccf47681..8c4b46ac27f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2beab781832..9f48f14270d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,8 @@ 2007-04-12 Tobias Schlüter + PR fortran/31250 + * gfortran.dg/char_length_2.f90: New. + PR fortran/31266 * gfortran.dg/char_assign_1.f90: New. diff --git a/gcc/testsuite/gfortran.dg/char_length_2.f90 b/gcc/testsuite/gfortran.dg/char_length_2.f90 new file mode 100644 index 00000000000..dc2efb94f77 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_length_2.f90 @@ -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