[gfortran,patch] Fix PR27588: Add substring-out-of-bounds check

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

The attached patch adds a "substring out of bounds" check, in the spirit
of trans-array.c's gfc_trans_array_bound_check.

This is an improved version; the first
(http://gcc.gnu.org/ml/gcc-patches/2006-10/msg00234.html) didn't
displayed the right line number and no variable name; the second by FX
(http://gcc.gnu.org/ml/gcc-patches/2006-10/msg01030.html) added the
variable name  - and this version fixes the line-number display.

I used CBND1, CBND2 and CBND4 of
http://www.polyhedron.com/pb05/linux/diagnose.html, which all are
detected (with variable name), which increases our diagnostics
statistics from 34% -> 39% ;-)

FX wrote (regarding his patch): "I've been working to find how to output
the variable name, [...] but it still doesn't work in all cases."
If you find an example where it does not work, I'm happy to look at it.
(I didn't find one, but I didn't look for it extensively)

Compiled and regtested on x86_64-unknown-linux-gnu-gcc.
Ok for the trunk?

Tobias

2006-11-11 Tobias Burnus  <burnus@net-b.de>

	PR fortran/27588
	* trans-expr.c: Add substring boundary check to gfc_conv_substring
	* gfortran.dg/

2006-11-11 Tobias Burnus  <burnus@net-b.de>

	PR fortran/27588
	* gfortran.dg/char_bounds_check_fail_1.f90


Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(Revision 118668)
--- gcc/fortran/trans-expr.c	(Arbeitskopie)
*************** gfc_trans_init_string_length (gfc_charle
*** 234,246 ****
  
  
  static void
! gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
  {
    tree tmp;
    tree type;
    tree var;
    gfc_se start;
    gfc_se end;
  
    type = gfc_get_character_type (kind, ref->u.ss.length);
    type = build_pointer_type (type);
--- 234,249 ----
  
  
  static void
! gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
! 		    const char *name, locus *where)
  {
    tree tmp;
    tree type;
    tree var;
+   tree fault;
    gfc_se start;
    gfc_se end;
+   char *msg;
  
    type = gfc_get_character_type (kind, ref->u.ss.length);
    type = build_pointer_type (type);
*************** gfc_conv_substring (gfc_se * se, gfc_ref
*** 272,277 ****
--- 275,307 ----
        gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
        gfc_add_block_to_block (&se->pre, &end.pre);
      }
+   if (flag_bounds_check)
+     {
+       /* Check lower bound.  */
+       fault = fold_build2 (LT_EXPR, boolean_type_node, start.expr,
+                            build_int_cst (gfc_charlen_type_node, 1));
+       if (name)
+ 	asprintf (&msg, "Substring out of bounds: lower bound of '%s' "
+ 		  "is less than one", name);
+       else
+ 	asprintf (&msg, "Substring out of bounds: lower bound "
+ 		  "is less than one");
+       gfc_trans_runtime_check (fault, msg, &se->pre, where);
+       gfc_free (msg);
+ 
+       /* Check upper bound.  */
+       fault = fold_build2 (GT_EXPR, boolean_type_node, end.expr,
+                            se->string_length);
+       if (name)
+ 	asprintf (&msg, "Substring out of bounds: upper bound of '%s' "
+ 		  "exceeds string length", name);
+       else
+ 	asprintf (&msg, "Substring out of bounds: upper bound "
+ 		  "exceeds string length");
+       gfc_trans_runtime_check (fault, msg, &se->pre, where);
+       gfc_free (msg);
+     }
+ 
    tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node,
  		     build_int_cst (gfc_charlen_type_node, 1),
  		     start.expr);
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 485,491 ****
  	  break;
  
  	case REF_SUBSTRING:
! 	  gfc_conv_substring (se, ref, expr->ts.kind);
  	  break;
  
  	default:
--- 515,522 ----
  	  break;
  
  	case REF_SUBSTRING:
! 	  gfc_conv_substring (se, ref, expr->ts.kind,
! 			      expr->symtree->name, &expr->where);
  	  break;
  
  	default:
*************** gfc_conv_substring_expr (gfc_se * se, gf
*** 2958,2964 ****
    se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
    TYPE_STRING_FLAG (TREE_TYPE (se->expr))=1;
  
!   gfc_conv_substring(se,ref,expr->ts.kind);
  }
  
  
--- 2989,2995 ----
    se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
    TYPE_STRING_FLAG (TREE_TYPE (se->expr))=1;
  
!   gfc_conv_substring(se,ref,expr->ts.kind,NULL,&expr->where);
  }
  
  
--- /dev/null	2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90	2006-11-10 22:56:42.000000000 +0100
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Substring out of bounds check" }
+! PR fortran/27588
+program bound_check
+      character*10 zz
+      i = 2
+      j = i+9
+      zz(i:j) = 'abcdef'
+      print * , zz
+      end
+! { dg-output "Substring out of bounds: upper bound exceeds string length.*at line 9)}