This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR27996 and PR29978 - warnings and errors on character lengths
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Tobias Burnus <burnus at net-b dot de>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>, Fortran List <fortran at gcc dot gnu dot org>
- Date: Thu, 30 Nov 2006 22:41:20 +0100
- Subject: Re: [Patch, fortran] PR27996 and PR29978 - warnings and errors on character lengths
- References: <456DE684.1030000@wanadoo.fr> <456DF8C3.2080507@net-b.de>
Tobias,
And as Fortran 2003 requires the same you should use GFC_STD_GNU.
Done - OK
What is the difference between a and b? Or asking differently: Why is
the error detected for "a" and not for "b"?
This is embarrassing.... I asked myself the same question, couldn't
answer it, left it for a week and forgot about it :-)
It truns out that for the initializer errors are cleared so that
gfc_notify_std doesn't work Applying gfc_error_check causes it to report
multiply. I have therefore applied GFC_STD_GNU by hand and used
gfc_error_now.
Regtests on Cygwin_NT/amd64 OK now for trunk?
Thanks
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 119271)
--- 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)
*** 3929,3935 ****
&& 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;
--- 3941,3947 ----
&& 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 119271)
--- 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 119271)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 1629,1634 ****
--- 1629,1635 ----
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 119272)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_code (gfc_code * code, gfc_names
*** 4928,4933 ****
--- 4928,4954 ----
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->length
+ && 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 119271)
--- 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 119271)
--- gcc/fortran/options.c (working copy)
*************** set_Wall (void)
*** 301,306 ****
--- 301,307 ----
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