diff options
| author | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-10-13 10:51:21 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2016-10-13 10:51:21 +0200 |
| commit | 92c5266bbd5378a5513f43edf23b1394621675a3 (patch) | |
| tree | be349c6c53e4349df797771ee987f711b4e773ce /gcc/fortran/trans-expr.c | |
| parent | 1202f33e5e1e4236fec7a3c1d14c16b5f13c2aaa (diff) | |
| download | gcc-92c5266bbd5378a5513f43edf23b1394621675a3.zip gcc-92c5266bbd5378a5513f43edf23b1394621675a3.tar.gz gcc-92c5266bbd5378a5513f43edf23b1394621675a3.tar.bz2 | |
re PR fortran/72832 ([OOP] ALLOCATE with SOURCE fails to allocate requested dimensions)
gcc/fortran/ChangeLog:
2016-09-01 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/72832
* trans-expr.c (gfc_copy_class_to_class): Add generation of
runtime array bounds check.
* trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to
get the descriptor of a function returning a class object.
* trans-stmt.c (gfc_trans_allocate): Use the array spec on the
array to allocate instead of the array spec from source=.
gcc/testsuite/ChangeLog:
2016-09-01 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/72832
* gfortran.dg/allocate_with_source_22.f03: New test.
* gfortran.dg/allocate_with_source_23.f03: New test. Expected to
fail.
From-SVN: r241088
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. */ |