Tobias,
When I try to bootstrap with your patch, I get an ICE with
libgfortran/generated/misc_specifics.F90.
Reduced test case:
This is now fixed in the attached. Also, your other comments have
been acted upon. Furthermore, I have bootstratpped and regtested on
ia64/FC5.
I think that it is now OK for trunk and, after the usual delay, for
4.1. OK with you?
Paul
------------------------------------------------------------------------
2006-11-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/27996
PR fortran/27998
* decl.c (gfc_set_constant_character_len): Add boolean arg to
flag array constructor resolution. Warn if string is being
truncated. Standard dependent error if string is padded. Set
new arg to false for all three calls to
gfc_set_constant_character_len.
* match.h : Add boolean arg to prototype for
gfc_set_constant_character_len.
* gfortran.h : Add warn_character_truncation to gfc_options.
* options.c (set_Wall): Set warn_character_truncation if -Wall
is set.
* resolve.c (resolve_code): Warn if rhs string in character
assignment has to be truncated.
* array.c (gfc_resolve_character_array_constructor): Set new
argument to true for call to gfc_set_constant_character_len.
2006-11-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/27996
PR fortran/27998
* gfortran.dg/char_length_1.f90: New test.
------------------------------------------------------------------------
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 120260)
--- gcc/fortran/decl.c (working copy)
*************** build_sym (const char *name, gfc_charlen
*** 743,749 ****
truncated. */
void
! gfc_set_constant_character_len (int len, gfc_expr * expr)
{
char * s;
int slen;
--- 743,749 ----
truncated. */
void
! gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
{
char * s;
int slen;
*************** gfc_set_constant_character_len (int len,
*** 758,763 ****
--- 758,775 ----
memcpy (s, expr->value.character.string, MIN (len, slen));
if (len > slen)
memset (&s[slen], ' ', len - slen);
+
+ if (gfc_option.warn_character_truncation && slen > len)
+ gfc_warning_now ("CHARACTER expression at %L is being truncated "
+ "(%d/%d)", &expr->where, slen, len);
+
+ /* Apply the standard by 'hand' otherwise it gets cleared for
+ initializers. */
+ if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU))
+ gfc_error_now ("The CHARACTER elements of the array constructor "
+ "at %L must have the same length (%d/%d)",
+ &expr->where, slen, len);
+
s[len] = '\0';
gfc_free (expr->value.character.string);
expr->value.character.string = s;
*************** add_init_expr_to_sym (const char *name,
*** 909,921 ****
gfc_constructor * p;
if (init->expr_type == EXPR_CONSTANT)
! gfc_set_constant_character_len (len, init);
else if (init->expr_type == EXPR_ARRAY)
{
gfc_free_expr (init->ts.cl->length);
init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
for (p = init->value.constructor; p; p = p->next)
! gfc_set_constant_character_len (len, p->expr);
}
}
}
--- 921,933 ----
gfc_constructor * p;
if (init->expr_type == EXPR_CONSTANT)
! gfc_set_constant_character_len (len, init, false);
else if (init->expr_type == EXPR_ARRAY)
{
gfc_free_expr (init->ts.cl->length);
init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length);
for (p = init->value.constructor; p; p = p->next)
! gfc_set_constant_character_len (len, p->expr, false);
}
}
}
*************** do_parm (void)
*** 4025,4031 ****
&& init->ts.type == BT_CHARACTER
&& init->ts.kind == 1)
gfc_set_constant_character_len (
! mpz_get_si (sym->ts.cl->length->value.integer), init);
sym->value = init;
return MATCH_YES;
--- 4037,4043 ----
&& init->ts.type == BT_CHARACTER
&& init->ts.kind == 1)
gfc_set_constant_character_len (
! mpz_get_si (sym->ts.cl->length->value.integer), init, false);
sym->value = init;
return MATCH_YES;
Index: gcc/fortran/array.c
===================================================================
*** gcc/fortran/array.c (revision 120260)
--- gcc/fortran/array.c (working copy)
*************** got_charlen:
*** 1587,1593 ****
/* Update the element constructors. */
for (p = expr->value.constructor; p; p = p->next)
if (p->expr->expr_type == EXPR_CONSTANT)
! gfc_set_constant_character_len (max_length, p->expr);
}
}
}
--- 1587,1593 ----
/* Update the element constructors. */
for (p = expr->value.constructor; p; p = p->next)
if (p->expr->expr_type == EXPR_CONSTANT)
! gfc_set_constant_character_len (max_length, p->expr, true);
}
}
}
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 120260)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 1637,1642 ****
--- 1637,1643 ----
int warn_surprising;
int warn_tabs;
int warn_underflow;
+ int warn_character_truncation;
int max_errors;
int flag_all_intrinsics;
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 120260)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_code (gfc_code * code, gfc_names
*** 4966,4971 ****
--- 4966,4993 ----
goto call;
}
+ if (code->expr->ts.type == BT_CHARACTER
+ && gfc_option.warn_character_truncation)
+ {
+ int llen = 0, rlen = 0;
+ gfc_symbol *sym;
+ sym = code->expr->symtree->n.sym;
+ if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+ llen = mpz_get_si (sym->ts.cl->length->value.integer);
+
+ if (code->expr2->expr_type == EXPR_CONSTANT)
+ rlen = code->expr2->value.character.length;
+
+ else if (code->expr2->ts.cl != NULL
+ && code->expr2->ts.cl->length != NULL
+ && code->expr2->ts.cl->length->expr_type == EXPR_CONSTANT)
+ rlen = mpz_get_si (code->expr2->ts.cl->length->value.integer);
+
+ if (rlen && llen && rlen > llen)
+ gfc_warning_now ("rhs of CHARACTER assignment at %L will "
+ "be truncated (%d/%d)", &code->loc, rlen, llen);
+ }
+
if (gfc_pure (NULL))
{
if (gfc_impure_variable (code->expr->symtree->n.sym))
Index: gcc/fortran/match.h
===================================================================
*** gcc/fortran/match.h (revision 120260)
--- gcc/fortran/match.h (working copy)
*************** match gfc_match_derived_decl (void);
*** 130,136 ****
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
! void gfc_set_constant_character_len (int, gfc_expr *);
/* Matchers for attribute declarations */
match gfc_match_allocatable (void);
--- 130,136 ----
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
! void gfc_set_constant_character_len (int, gfc_expr *, bool);
/* Matchers for attribute declarations */
match gfc_match_allocatable (void);
Index: gcc/fortran/options.c
===================================================================
*** gcc/fortran/options.c (revision 120260)
--- gcc/fortran/options.c (working copy)
*************** set_Wall (void)
*** 309,314 ****
--- 309,315 ----
gfc_option.warn_surprising = 1;
gfc_option.warn_tabs = 0;
gfc_option.warn_underflow = 1;
+ gfc_option.warn_character_truncation = 1;
set_Wunused (1);
warn_return_type = 1;
Index: gcc/testsuite/gfortran.dg/char_length_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_length_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/char_length_1.f90 (revision 0)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do compile }
+ ! { dg-options "-Wall -std=f2003" }
+ ! Tests the patch for PR27996 and PR27998, in which warnings
+ ! or errors were not emitted when the length of character
+ ! constants was changed silently.
+ !
+ ! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de>
+ !
+ program test
+ character(10) :: a(3)
+ character(10) :: b(3)= &
+ (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "same length" }
+ character(4) :: c = "abcde" ! { dg-warning "being truncated" }
+ a = (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "same length" }
+ a = (/ 'Takata ', 'Tanaka ', 'Hayashi' /)
+ b = "abc"
+ c = "abcdefg" ! { dg-warning "will be truncated" }
+ end program test