diff options
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a880f0e..b03cc94 100644 --- 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); } } |