diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 26 |
1 files changed, 26 insertions, 0 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 655399b..6b974db 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1235,6 +1235,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) stmtblock_t body; stmtblock_t ifbody; gfc_loopinfo loop; + tree orig_nelems = nelems; /* Needed for bounds check. */ gfc_init_block (&body); tmp = fold_build2_loc (input_location, MINUS_EXPR, @@ -1262,6 +1263,31 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) } vec_safe_push (args, to_ref); + /* Add bounds check. */ + if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc) + { + char *msg; + const char *name = "<<unknown>>"; + tree from_len; + + if (DECL_P (to)) + name = (const char *)(DECL_NAME (to)->identifier.id.str); + + from_len = gfc_conv_descriptor_size (from_data, 1); + tmp = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, from_len, orig_nelems); + msg = xasprintf ("Array bound mismatch for dimension %d " + "of array '%s' (%%ld/%%ld)", + 1, name); + + gfc_trans_runtime_check (true, false, tmp, &body, + &gfc_current_locus, msg, + fold_convert (long_integer_type_node, orig_nelems), + fold_convert (long_integer_type_node, from_len)); + + free (msg); + } + tmp = build_call_vec (fcn_type, fcn, args); /* Build the body of the loop. */ |