This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [Patch, fortran] PR27996 and PR29978 - warnings and errors on character lengths


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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]