re PR fortran/31538 (misleading bounds check error)

2010-04-17  Steven G. Kargl  <kargl@gcc.gnu.org>

   PR fortran/31538
   * gfortran.dg/bounds_check_fail_4.f90: Adjust error message.
   * gfortran.dg/bounds_check_fail_3.f90: Ditto.

2010-04-17  Steven G. Kargl  <kargl@gcc.gnu.org>

   PR fortran/31538
   * fortran/trans-array.c (gfc_conv_ss_startstride): Remove the use of
   gfc_msg_bounds by using 'Array bound mismatch' directly.
   (gfc_trans_dummy_array_bias):  Remove the use of gfc_msg_bounds.  Reword
   error message to include the mismatch in the extent of array bound.
   * fortran/trans.c: Remove gfc_msg_bounds.  It is only used in one place.
   * fortran/trans.h: Remove extern definition of gfc_msg_bounds.

From-SVN: r158474

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e672f84e709c106c9fda91a7fc9b9bc9c3ce0f5e..377fe183f51e81a6dce903e61e90ef31afa93bfa 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2010-04-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+   PR fortran/31538
+   * fortran/trans-array.c (gfc_conv_ss_startstride): Remove the use of
+   gfc_msg_bounds by using 'Array bound mismatch' directly.
+   (gfc_trans_dummy_array_bias):  Remove the use of gfc_msg_bounds.  Reword
+   error message to include the mismatch in the extent of array bound.
+   * fortran/trans.c: Remove gfc_msg_bounds.  It is only used in one place.
+   * fortran/trans.h: Remove extern definition of gfc_msg_bounds.
+
 2010-04-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        * gfortran.texi: Update information on temporary file locations.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a880f0efe6123c9d29f28620fa3dd966545543ad..b03cc9400c92649410a1a2baed89325791680d61 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3365,13 +3365,15 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
              if (size[n])
                {
                  tmp3 = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
-                 asprintf (&msg, "%s, size mismatch for dimension %d "
-                           "of array '%s' (%%ld/%%ld)", gfc_msg_bounds,
+                 asprintf (&msg, "Array bound mismatch for dimension %d "
+                           "of array '%s' (%%ld/%%ld)",
                            info->dim[n]+1, ss->expr->symtree->name);
+
                  gfc_trans_runtime_check (true, false, tmp3, &inner,
                                           &ss->expr->where, msg,
                        fold_convert (long_integer_type_node, tmp),
                        fold_convert (long_integer_type_node, size[n]));
+
                  gfc_free (msg);
                }
              else
@@ -4632,15 +4634,26 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
            {
              /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)).  */
              char * msg;
+             tree temp;
 
-             tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-                                ubound, lbound);
-              stride2 = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+             temp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                                 ubound, lbound);
+             temp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                                 gfc_index_one_node, temp);
+
+             stride2 = fold_build2 (MINUS_EXPR, gfc_array_index_type,
                                     dubound, dlbound);
-              tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
-             asprintf (&msg, "%s for dimension %d of array '%s'",
-                       gfc_msg_bounds, n+1, sym->name);
-             gfc_trans_runtime_check (true, false, tmp, &block, &loc, msg);
+             stride2 = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                                    gfc_index_one_node, stride2);
+
+              tmp = fold_build2 (NE_EXPR, gfc_array_index_type, temp, stride2);
+             asprintf (&msg, "Dimension %d of array '%s' has extent "
+                       "%%ld instead of %%ld", n+1, sym->name);
+
+             gfc_trans_runtime_check (true, false, tmp, &block, &loc, msg, 
+                       fold_convert (long_integer_type_node, temp),
+                       fold_convert (long_integer_type_node, stride2));
+
              gfc_free (msg);
            }
        }

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index c1993f90ddd0e46bcea5451dd739c2578d59f159..21c56045a44f9d5f37a232a1b59fc311de50a445 100644 (file)
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -47,7 +47,6 @@ along with GCC; see the file COPYING3.  If not see
 
 static gfc_file *gfc_current_backend_file;
 
-const char gfc_msg_bounds[] = N_("Array bound mismatch");
 const char gfc_msg_fault[] = N_("Array reference out of bounds");
 const char gfc_msg_wrong_return[] = N_("Incorrect function return value");
 

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 782ff1d9e78816232589eafc44d97a2f38eb8451..91f1b7784d14555f8b4d080aaedfae6b37651b4f 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -773,7 +773,6 @@ void gfc_apply_interface_mapping (gfc_interface_mapping *,
 
 
 /* Standard error messages used in all the trans-*.c files.  */
-extern const char gfc_msg_bounds[];
 extern const char gfc_msg_fault[];
 extern const char gfc_msg_wrong_return[];
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ac81da73654e3f21e3035317d36a4fdbbb1c2ed7..a926c843534368d7fe4e99b9e4dc92c90b8b366d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-04-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+   PR fortran/31538
+   * gfortran.dg/bounds_check_fail_4.f90: Adjust error message.
+   * gfortran.dg/bounds_check_fail_3.f90: Ditto.
+
 2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/sizetype.adb: Rename into...

diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90
index 0826b7d5efcf45bb244eb4666a2f93bb9d46e3ed..ce4d0368d57e39a10e02cc794d83ebd84edababe 100644 (file)
--- a/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_3.f90
@@ -9,4 +9,4 @@
   if (any(x /= (/ 2, 2, 3, 4, 5, 6, 6, 8, 9, 10 /))) call abort()
   x(8:1:m) = x(5:2:n) 
   end
-! { dg-output "line 10 .* bound mismatch, .* dimension 1 .* array \'x\' \\\(3/2\\\)" }
+! { dg-output "line 10 .* bound mismatch .* dimension 1 .* array \'x\' \\\(3/2\\\)" }

diff --git a/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90
index dee3ca8d66ed49ce00664664d4236a9c044f89b9..718d0058e4909c62875021bed683f5c69796b266 100644 (file)
--- a/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_fail_4.f90
@@ -9,4 +9,4 @@
   if (any(x /= (/ 5, 2, 3, 6, 5, 6, 7, 8, 9, 10 /))) call abort()
   x(8:1:m) = x(1:3) + x(5:2:n) 
   end
-! { dg-output "line 10 .* bound mismatch, .* dimension 1 .* array \'x\' \\\(2/3\\\)" }
+! { dg-output "line 10 .* bound mismatch .* dimension 1 .* array \'x\' \\\(2/3\\\)" }