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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@123763
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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;
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;
static try
resolve_charlen (gfc_charlen *cl)
{
+ int i;
+
if (cl->resolved)
return SUCCESS;
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;
}
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);
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)
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.
--- /dev/null
+! { 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