[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.

The output error is (e.g.):
Fortran runtime error: Substring out of bounds: lower bound is less than
one (in file 'string2.f90', at line 5)
Fortran runtime error: Substring out of bounds: upper bound exceeds
string length (in file 'cbnd1.for', at line 5)

In principle there is also a version which outputs the variable name,
but this does not work (contrary to gfc_trans_array_bound_check, where
also both versions exist). Either it is not available, or I check the
wrong variable.

There is another problem:
The location shown is off by one line; e.g.
cat -n testsuite/gfortran.dg/char_bounds_check_fail_1.f90
[...]
     8        j = i+9
     9        zz(i:j) = 'abcdef'
~> gfortran -fbounds-check char_bounds_check_fail_1.f90; ./a.out
Fortran runtime error: Substring out of bounds: upper bound exceeds
string length (in file 'char_bounds_check_fail_1.f90', at line 8)
I probably mishandle gfc_get_backend_locus(&loc); but I fail to see,
how to do this properly.

The patch fixes PR27588 and passes also the cbnd1, cbnd2 and cbnd4 test
of the http://www.polyhedron.com/pb05/linux/diagnose.html test suit
(modulo line number).

Tobias


2006-10-04 Tobias Burnus <burnus@net-b.de>
    PR fortran/27588
    * trans-expr.c: Add substring boundary check to gfc_conv_substring
    * gfortran.dg/

2006-10-04 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 117430)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_substring (gfc_se * se, gfc_ref
*** 239,246 ****
--- 239,249 ----
    tree tmp;
    tree type;
    tree var;
+   tree fault;
    gfc_se start;
    gfc_se end;
+   locus loc;
+   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,310 ----
        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.  */
+       gfc_get_backend_locus(&loc);
+       fault = fold_build2 (LT_EXPR, boolean_type_node, start.expr,
+                            build_int_cst (gfc_charlen_type_node, 1));
+       if (se->ss)
+           asprintf (&msg,
+             "Substring out of bounds: lower bound of '%s' is less than one",
+             se->ss->expr->symtree->name);
+       else
+           asprintf (&msg,
+             "Substring out of bounds: lower bound is less than one");
+       gfc_trans_runtime_check (fault, msg, &se->pre, &loc);
+       gfc_free (msg);
+ 
+       /* Check upper bound.  */
+       fault = fold_build2 (GT_EXPR, boolean_type_node, end.expr,
+                            se->string_length);
+       if (se->ss)
+           asprintf (&msg,
+             "Substring out of bounds: upper bound of '%s' exceeds string length",
+             se->ss->expr->symtree->name);
+       else
+           asprintf (&msg,
+             "Substring out of bounds: upper bound exceeds string length");
+       gfc_trans_runtime_check (fault, msg, &se->pre, &loc);
+       gfc_free (msg);
+     }
+ 
    tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node,
  		     build_int_cst (gfc_charlen_type_node, 1),
  		     start.expr);
--- /dev/null	2006-09-26 21:08:37.000000000 +0200
+++ gcc/testsuite/gfortran.dg/char_bounds_check_fail_1.f90	2006-10-04 18:01:30.804168750 +0200
@@ -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 8)}