fortran/

2006-11-15  Tobias Burnus  <burnus@net-b.de>
            Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

       PR fortran/27588
       * trans-expr.c (gfc_conv_substring): Add bounds checking.
         (gfc_conv_variable, gfc_conv_substring_expr): Pass more
         arguments to gfc_conv_substring.

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

       PR fortran/27588
       * gfortran.dg/char_bounds_check_fail_1.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118852 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4486399..ea2d741 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,12 @@
 2006-11-15  Tobias Burnus  <burnus@net-b.de>
+           Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/27588
+       * trans-expr.c (gfc_conv_substring): Add bounds checking.
+         (gfc_conv_variable, gfc_conv_substring_expr): Pass more
+         arguments to gfc_conv_substring.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/29806
        * parse.c (parse_contained): Check for empty contains statement.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 6d8b8b9..984c6d3 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -234,13 +234,16 @@ gfc_trans_init_string_length (gfc_charlen * cl, stmtblock_t * pblock)
 
 
 static void
-gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
+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);
@@ -272,6 +275,33 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
       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);
@@ -485,7 +515,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
          break;
 
        case REF_SUBSTRING:
-         gfc_conv_substring (se, ref, expr->ts.kind);
+         gfc_conv_substring (se, ref, expr->ts.kind,
+                             expr->symtree->name, &expr->where);
          break;
 
        default:
@@ -2958,7 +2989,7 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr)
   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);
+  gfc_conv_substring(se,ref,expr->ts.kind,NULL,&expr->where);
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0288e55..c485ed6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2006-11-15  Tobias Burnus  <burnus@net-b.de>
 
+       PR fortran/27588
+       * gfortran.dg/char_bounds_check_fail_1.f90: New test.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
+
        PR fortran/29806
        * gfortran.dg/contains.f90: New test.
        * gfortran.dg/derived_function_interface_1.f90: Add a dg-warning.