aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-array.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r--gcc/fortran/trans-array.c84
1 files changed, 55 insertions, 29 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index abbf8f6..78b038a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2097,9 +2097,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
gfc_msg_fault, name, n+1);
else
- asprintf (&msg, "%s, lower bound of dimension %d exceeded",
- gfc_msg_fault, n+1);
- gfc_trans_runtime_check (fault, msg, &se->pre, where);
+ asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is "
+ "smaller than %%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));
gfc_free (msg);
/* Check upper bound. */
@@ -2111,9 +2113,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
asprintf (&msg, "%s for array '%s', upper bound of dimension %d "
" exceeded", gfc_msg_fault, name, n+1);
else
- asprintf (&msg, "%s, upper bound of dimension %d exceeded",
- gfc_msg_fault, n+1);
- gfc_trans_runtime_check (fault, msg, &se->pre, where);
+ asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is "
+ "larger than %%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));
gfc_free (msg);
}
@@ -2300,9 +2304,12 @@ 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", gfc_msg_fault,
- sym->name, n+1);
- gfc_trans_runtime_check (cond, msg, &se->pre, where);
+ "lower bound of dimension %d exceeded, %%ld is smaller "
+ "than %%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),
+ fold_convert (long_integer_type_node, tmp));
gfc_free (msg);
/* Upper bound, but not for the last dimension of assumed-size
@@ -2314,9 +2321,12 @@ 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", gfc_msg_fault,
- sym->name, n+1);
- gfc_trans_runtime_check (cond, msg, &se->pre, where);
+ "upper bound of dimension %d exceeded, %%ld is "
+ "greater than %%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),
+ fold_convert (long_integer_type_node, tmp));
gfc_free (msg);
}
}
@@ -2872,7 +2882,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
asprintf (&msg, "Zero stride is not allowed, for dimension %d "
"of array '%s'", info->dim[n]+1,
ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg);
gfc_free (msg);
desc = ss->data.info.descriptor;
@@ -2912,9 +2922,13 @@ 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", gfc_msg_fault, info->dim[n]+1,
- ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ " exceeded, %%ld is smaller than %%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,
+ lbound));
gfc_free (msg);
if (check_upper)
@@ -2924,9 +2938,12 @@ 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", gfc_msg_fault, info->dim[n]+1,
+ "'%s' exceeded, %%ld is greater than %%ld",
+ gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ 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));
gfc_free (msg);
}
@@ -2944,9 +2961,13 @@ 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", gfc_msg_fault, info->dim[n]+1,
- ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ " exceeded, %%ld is smaller than %%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,
+ lbound));
gfc_free (msg);
if (check_upper)
@@ -2955,9 +2976,12 @@ 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", gfc_msg_fault, info->dim[n]+1,
+ "'%s' exceeded, %%ld is greater than %%ld",
+ gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
+ fold_convert (long_integer_type_node, tmp2),
+ fold_convert (long_integer_type_node, ubound));
gfc_free (msg);
}
@@ -2970,12 +2994,14 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
others against this. */
if (size[n])
{
- tmp =
- fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
+ tree tmp3
+ = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
asprintf (&msg, "%s, size mismatch for dimension %d "
- "of array '%s'", gfc_msg_bounds, info->dim[n]+1,
- ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+ "of array '%s' (%%ld/%%ld)", gfc_msg_bounds,
+ info->dim[n]+1, ss->expr->symtree->name);
+ gfc_trans_runtime_check (tmp3, &block, &ss->expr->where, msg,
+ fold_convert (long_integer_type_node, tmp),
+ fold_convert (long_integer_type_node, size[n]));
gfc_free (msg);
}
else
@@ -4194,7 +4220,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
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 (tmp, msg, &block, &loc);
+ gfc_trans_runtime_check (tmp, &block, &loc, msg);
gfc_free (msg);
}
}
generated by cgit v1.1 at 2025-06-02 05:47:59 +0000