[Patch, fortran] PR27996 and PR29978 - warnings and errors on character lengths
Paul Thomas
paulthomas2@wanadoo.fr
Wed Jan 3 20:33:00 GMT 2007
Ping!
> 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
>
More information about the Gcc-patches
mailing list