2007-10-14 Tobias Burnus <burnus@net-b.de>

        PR fortran/33745
        * trans-array.c (gfc_conv_ss_startstride): Fix dimension check.
        (gfc_trans_array_bound_check, gfc_conv_array_ref,
        gfc_conv_ss_startstride): Simplify error message.
        * resolve.c (check_dimension): Fix dimension-type switch;
        improve error message.

2007-10-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/33745
        * gfortran.dg/bounds_check_11.f90: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index eddaa91..717053a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2007-10-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33745
+       * trans-array.c (gfc_conv_ss_startstride): Fix dimension check.
+       (gfc_trans_array_bound_check, gfc_conv_array_ref,
+       gfc_conv_ss_startstride): Simplify error message.
+       * resolve.c (check_dimension): Fix dimension-type switch;
+       improve error message.
+
 2007-10-13  Tobias Schlüter  <tobi@gcc.gnu.org>
            Paul Thomas  <pault@gcc.gnu.org>
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 26c139c..2461bc3 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3215,20 +3215,32 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
 /* Given start, end and stride values, calculate the minimum and
    maximum referenced indexes.  */
 
-  switch (ar->type)
+  switch (ar->dimen_type[i])
     {
-    case AR_FULL:
+    case DIMEN_VECTOR:
       break;
 
-    case AR_ELEMENT:
+    case DIMEN_ELEMENT:
       if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
-       goto bound;
+       {
+         gfc_warning ("Array reference at %L is out of bounds "
+                      "(%ld < %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (ar->start[i]->value.integer),
+                      mpz_get_si (as->lower[i]->value.integer), i+1);
+         return SUCCESS;
+       }
       if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
-       goto bound;
+       {
+         gfc_warning ("Array reference at %L is out of bounds "
+                      "(%ld > %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (ar->start[i]->value.integer),
+                      mpz_get_si (as->upper[i]->value.integer), i+1);
+         return SUCCESS;
+       }
 
       break;
 
-    case AR_SECTION:
+    case DIMEN_RANGE:
       {
 #define AR_START (ar->start[i] ? ar->start[i] : as->lower[i])
 #define AR_END (ar->end[i] ? ar->end[i] : as->upper[i])
@@ -3253,9 +3265,22 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
            || (compare_bound_int (ar->stride[i], 0) == CMP_LT
                && comp_start_end == CMP_GT))
          {
-           if (compare_bound (AR_START, as->lower[i]) == CMP_LT
-               || compare_bound (AR_START, as->upper[i]) == CMP_GT)
-             goto bound;
+           if (compare_bound (AR_START, as->lower[i]) == CMP_LT)
+             {
+               gfc_warning ("Lower array reference at %L is out of bounds "
+                      "(%ld < %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (AR_START->value.integer),
+                      mpz_get_si (as->lower[i]->value.integer), i+1);
+               return SUCCESS;
+             }
+           if (compare_bound (AR_START, as->upper[i]) == CMP_GT)
+             {
+               gfc_warning ("Lower array reference at %L is out of bounds "
+                      "(%ld > %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (AR_START->value.integer),
+                      mpz_get_si (as->upper[i]->value.integer), i+1);
+               return SUCCESS;
+             }
          }
 
        /* If we can compute the highest index of the array section,
@@ -3264,11 +3289,23 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
        if (compute_last_value_for_triplet (AR_START, AR_END, ar->stride[i],
                                            last_value))
          {
-           if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT
-               || compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
+           if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT)
+             {
+               gfc_warning ("Upper array reference at %L is out of bounds "
+                      "(%ld < %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (last_value),
+                      mpz_get_si (as->lower[i]->value.integer), i+1);
+               mpz_clear (last_value);
+               return SUCCESS;
+             }
+           if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
              {
+               gfc_warning ("Upper array reference at %L is out of bounds "
+                      "(%ld > %ld) in dimension %d", &ar->c_where[i],
+                      mpz_get_si (last_value),
+                      mpz_get_si (as->upper[i]->value.integer), i+1);
                mpz_clear (last_value);
-               goto bound;
+               return SUCCESS;
              }
          }
        mpz_clear (last_value);
@@ -3283,10 +3320,6 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
     }
 
   return SUCCESS;
-
-bound:
-  gfc_warning ("Array reference at %L is out of bounds", &ar->c_where[i]);
-  return SUCCESS;
 }
 
 

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4fb1fda..c598d25 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2109,11 +2109,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
   tmp = gfc_conv_array_lbound (descriptor, n);
   fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp);
   if (name)
-    asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
-             gfc_msg_fault, name, n+1);
+    asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded"
+             "(%%ld < %%ld)", gfc_msg_fault, name, n+1);
   else
-    asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is "
-             "smaller than %%ld", gfc_msg_fault, n+1);
+    asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)",
+             gfc_msg_fault, n+1);
   gfc_trans_runtime_check (fault, &se->pre, where, msg,
                           fold_convert (long_integer_type_node, index),
                           fold_convert (long_integer_type_node, tmp));
@@ -2126,10 +2126,10 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
       fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
       if (name)
        asprintf (&msg, "%s for array '%s', upper bound of dimension %d "
-                       " exceeded", gfc_msg_fault, name, n+1);
+                       " exceeded (%%ld > %%ld)", gfc_msg_fault, name, n+1);
       else
-       asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is "
-                 "larger than %%ld", gfc_msg_fault, n+1);
+       asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)",
+                 gfc_msg_fault, n+1);
       gfc_trans_runtime_check (fault, &se->pre, where, msg,
                               fold_convert (long_integer_type_node, index),
                               fold_convert (long_integer_type_node, tmp));
@@ -2323,8 +2323,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
          cond = fold_build2 (LT_EXPR, boolean_type_node, 
                              indexse.expr, tmp);
          asprintf (&msg, "%s for array '%s', "
-                   "lower bound of dimension %d exceeded, %%ld is smaller "
-                   "than %%ld", gfc_msg_fault, sym->name, n+1);
+                   "lower bound of dimension %d exceeded (%%ld < %%ld)",
+                   gfc_msg_fault, sym->name, n+1);
          gfc_trans_runtime_check (cond, &se->pre, where, msg,
                                   fold_convert (long_integer_type_node,
                                                 indexse.expr),
@@ -2340,8 +2340,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
              cond = fold_build2 (GT_EXPR, boolean_type_node, 
                                  indexse.expr, tmp);
              asprintf (&msg, "%s for array '%s', "
-                       "upper bound of dimension %d exceeded, %%ld is "
-                       "greater than %%ld", gfc_msg_fault, sym->name, n+1);
+                       "upper bound of dimension %d exceeded (%%ld > %%ld)",
+                       gfc_msg_fault, sym->name, n+1);
              gfc_trans_runtime_check (cond, &se->pre, where, msg,
                                   fold_convert (long_integer_type_node,
                                                 indexse.expr),
@@ -2888,7 +2888,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
              if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
                continue;
 
-             if (n == info->ref->u.ar.dimen - 1
+             if (dim == info->ref->u.ar.dimen - 1
                  && (info->ref->u.ar.as->type == AS_ASSUMED_SIZE
                      || info->ref->u.ar.as->cp_was_assumed))
                check_upper = false;
@@ -2941,7 +2941,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
              tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
                                 non_zerosized, tmp);
              asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
-                       " exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
+                       " exceeded (%%ld < %%ld)", gfc_msg_fault,
                        info->dim[n]+1, ss->expr->symtree->name);
              gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
                                       fold_convert (long_integer_type_node,
@@ -2957,9 +2957,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
                  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
                                     non_zerosized, tmp);
                  asprintf (&msg, "%s, upper bound of dimension %d of array "
-                           "'%s' exceeded, %%ld is greater than %%ld",
-                           gfc_msg_fault, info->dim[n]+1,
-                           ss->expr->symtree->name);
+                           "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault,
+                           info->dim[n]+1, ss->expr->symtree->name);
                  gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
                        fold_convert (long_integer_type_node, info->start[n]),
                        fold_convert (long_integer_type_node, ubound));
@@ -2980,7 +2979,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
              tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
                                 non_zerosized, tmp);
              asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
-                       " exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
+                       " exceeded (%%ld < %%ld)", gfc_msg_fault,
                        info->dim[n]+1, ss->expr->symtree->name);
              gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
                                       fold_convert (long_integer_type_node,
@@ -2995,9 +2994,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
                  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
                                     non_zerosized, tmp);
                  asprintf (&msg, "%s, upper bound of dimension %d of array "
-                           "'%s' exceeded, %%ld is greater than %%ld",
-                           gfc_msg_fault, info->dim[n]+1,
-                           ss->expr->symtree->name);
+                           "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault,
+                           info->dim[n]+1, ss->expr->symtree->name);
                  gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
                        fold_convert (long_integer_type_node, tmp2),
                        fold_convert (long_integer_type_node, ubound));

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index abfa770..4ec1dc3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,6 +1,11 @@
+2007-10-14  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/33745
+       * gfortran.dg/bounds_check_11.f90: New.
+
 2007-10-14  Andrew Pinski  <pinskia@gmail.com>
 
-        PR c++/30303
+       PR c++/30303
        * g++.dg/other/ctor1.C: New test.
        * g++.dg/other/ctor2.C: New test.
        * g++.dg/other/dtor1.C: New test.

diff --git a/gcc/testsuite/gfortran.dg/bounds_check_11.f90 b/gcc/testsuite/gfortran.dg/bounds_check_11.f90
new file mode 100644 (file)
index 0000000..648e1d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_11.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Array bound checking" }
+! PR fortran/33745
+!
+! Don't check upper bound of assumed-size array
+!
+
+program test
+ implicit none
+ integer, parameter :: maxss=7,maxc=8
+ integer :: jp(2,maxc)
+ call findphase(jp)
+contains
+  subroutine findphase(jp)
+    integer, intent(out) :: jp(2,*)
+    jp(2,2:4)=0
+    jp(2,0:4)=0 ! { dg-warning "out of bounds" }
+    jp(3,1:4)=0 ! { dg-warning "out of bounds" }
+  end subroutine
+end program test
+
+! { dg-output "At line 18 of file .*" }
+! { dg-output "Array reference out of bounds, lower bound of dimension 2 of array 'jp' exceeded .0 < 1." }
+