From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 6236 invoked by alias); 6 Jul 2015 12:58:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 6214 invoked by uid 89); 6 Jul 2015 12:58:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.4 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.18) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Mon, 06 Jul 2015 12:58:28 +0000 Received: from vepi2 ([84.63.202.252]) by mail.gmx.com (mrgmx002) with ESMTPSA (Nemesis) id 0LikQP-1YcCnV1wqL-00d28k; Mon, 06 Jul 2015 14:58:24 +0200 Date: Mon, 06 Jul 2015 12:58:00 -0000 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Cc: Paul Richard Thomas , Mikael Morin Subject: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block Message-ID: <20150706145823.7e58cba2@vepi2> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/eNyd/k5Wd6JNQU=Apl6Op4M" X-UI-Out-Filterresults: notjunk:1;V01:K0:Y4LWgFQto2Q=:avTMuOSVVKIHnLGOvaHvac 2GKMygTdwBnSrSfKv4tTJvQiBIu3FuyUIdjkhhiHMF4tdodBn3WKQMeAhc+PoQdDd1LIxzR7U ZkpdGJhMU/p9QDet4wKdmj8mCkD3qC1Chx7/nhjBOAdpIGEW2va1r2GqO+q740FdFbsJ6KOfz Wo8CKHHJ85EWSexpv2gvew1g+ANO+MTrzL7y7yjtGq+em5CmnB7OJfhteFIFG0U3JBFn+Rk1T A83OUAA1r5c+F6XZYdVxTA1dZ1YKjxeXQ6nEJGt3jKuK7Z1mjQQQJseedhwCSlR5nYxsMAXce plYEXT7mp6PLbBh5TQ2WHbgPsBDcwCLgSOXQhDRxw1298vEENFV4wWTAT/nLm1N77BGDb3hoE GpSSIyHeA5qFmMQYQjYeXlDQhuZdlK2JsAaaDkUjIutDCdyBfKrZNUvD7evmnrCxsW1xE87h1 M3Q+zuUUv1M/Ztc5y9ZspS9JZ8hhm8KgXcpj2HRdk9mLBSHo5rTB5DrJIhEPu+nD1VgsCfrzn YwqTn4uJIyHfXXZiQlqWSMriYPOtzOnEvguVgEoHxT/EIWDfo2NWKk//ADuMRcHnQcZ+x4vjs MwktL47OasOJjPNWln4ihH01+Vbso4pFVkJqY4TaTFimS4T1V8fRBv9eSsI253kTHqw30TExn wUxXy9ui6ESgWgMBYmLwvb4X2vRSAVrBN4LDiOnoDYuq2Yg== X-SW-Source: 2015-07/txt/msg00329.txt.bz2 --MP_/eNyd/k5Wd6JNQU=Apl6Op4M Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 1071 Hi all, this is a proposal to patch PR 66578 https://gcc.gnu.org/bugzilla/show_bug.cgi?id=66578 . It extends work of Mikael Morin. The patch fixes two issues: 1. a source'd allocate in a block: allocate(c, source=a(:)). The issues occurs because due to the new handling of source-expressions in trans_allocate() an array descriptor is created where previously just a plain array was used. I.e., GFC_DESCRIPTOR_TYPE_P (source) is true now and GFC_ARRAY_TYPE_P (source) false, which made gfortran use the wrong bounds for the descriptor (zero-based instead of one-based). This was fixed by Mikael's proposal. 2. a two-level array addressing lead to a segfault. I.e., when in a source-expression an array was used to index another object, then the offset was computed incorrectly. Bootstraps and regtests fine on x86_64-linux-gnu/f21. Comments welcome! Regards, Andre PS: Experience shows that asking whether this ok for trunk is useless ;-) There is always something that could be improved. Open for suggestions. -- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/eNyd/k5Wd6JNQU=Apl6Op4M Content-Type: application/octet-stream; name=pr66578_1.clog Content-Transfer-Encoding: base64 Content-Disposition: attachment; filename=pr66578_1.clog Content-length: 480 Z2NjL3Rlc3RzdWl0ZS9DaGFuZ2VMb2c6CgoyMDE1LTA3LTA2ICBBbmRyZSBW ZWhyZXNjaGlsZCAgPHZlaHJlQGdteC5kZT4KCgkqIGdmb3J0cmFuLmRnL2Fs bG9jYXRlX3dpdGhfc291cmNlXzkuZjA4OiBOZXcgdGVzdC4KCgpnY2MvZm9y dHJhbi9DaGFuZ2VMb2c6CgoyMDE1LTA3LTA2ICBBbmRyZSBWZWhyZXNjaGls ZCAgPHZlaHJlQGdteC5kZT4KCgkqIHRyYW5zLWFycmF5LmMgKGdmY19jb252 X2V4cHJfZGVzY3JpcHRvcik6IEVuc3VyZSBhcnJheSBkZXNjcmlwdG9yCglp cyBvbmUtYmFzZWQgZm9yIG5vbi1mdWxsIGFycmF5IHJlZnMuIENvcnJlY3Qg dGhlIG9mZnNldCB3aGVuIGEKCXJhbmtfcmVtYXAgb2NjdXJzLgoK --MP_/eNyd/k5Wd6JNQU=Apl6Op4M Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr66578_1.patch Content-length: 5058 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index fece3ab..afea5ec 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6912,9 +6912,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tree from; tree to; tree base; - bool onebased = false; + bool onebased = false, rank_remap; ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen; + rank_remap = ss->dimen < ndim; if (se->want_coarray) { @@ -6947,6 +6948,22 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) if (expr->ts.type == BT_CHARACTER) se->string_length = gfc_get_expr_charlen (expr); + /* If we have an array section or are assigning make sure that + the lower bound is 1. References to the full + array should otherwise keep the original bounds. */ + if ((!info->ref || info->ref->u.ar.type != AR_FULL) && !se->want_pointer) + for (dim = 0; dim < loop.dimen; dim++) + if (!integer_onep (loop.from[dim])) + { + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, gfc_index_one_node, + loop.from[dim]); + loop.to[dim] = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + loop.to[dim], tmp); + loop.from[dim] = gfc_index_one_node; + } + desc = info->descriptor; if (se->direct_byref && !se->byref_noassign) { @@ -7040,20 +7057,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) from = loop.from[dim]; to = loop.to[dim]; - /* If we have an array section or are assigning make sure that - the lower bound is 1. References to the full - array should otherwise keep the original bounds. */ - if ((!info->ref - || info->ref->u.ar.type != AR_FULL) - && !integer_onep (from)) - { - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, gfc_index_one_node, - from); - to = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, to, tmp); - from = gfc_index_one_node; - } onebased = integer_onep (from); gfc_conv_descriptor_lbound_set (&loop.pre, parm, gfc_rank_cst[dim], from); @@ -7079,7 +7082,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) { tmp = gfc_conv_array_lbound (desc, n); tmp = fold_build2_loc (input_location, MINUS_EXPR, - TREE_TYPE (base), tmp, loop.from[dim]); + TREE_TYPE (base), tmp, from); tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (base), tmp, gfc_conv_array_stride (desc, n)); @@ -7114,7 +7117,19 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) /* Force the offset to be -1, when the lower bound of the highest dimension is one and the symbol is present and is not a pointer/allocatable or associated. */ - if (onebased && se->use_offset + if (((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) + && !se->data_not_needed) + || (se->use_offset && base != NULL_TREE)) + { + /* Set the offset depending on base. */ + tmp = rank_remap && !se->direct_byref ? + fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, base, + offset) + : base; + gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); + } + else if (onebased && (!rank_remap || se->use_offset) && expr->symtree && !(expr->symtree->n.sym && expr->symtree->n.sym->ts.type == BT_CLASS && !CLASS_DATA (expr->symtree->n.sym)->attr.class_pointer) @@ -7129,11 +7144,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) tmp = gfc_conv_mpz_to_tree (minus_one, gfc_index_integer_kind); gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); } - else if (((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc))) - && !se->data_not_needed) - || (se->use_offset && base != NULL_TREE)) - /* Set the offset depending on base. */ - gfc_conv_descriptor_offset_set (&loop.pre, parm, base); else { /* Only the callee knows what the correct offset it, so just set diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08 b/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08 new file mode 100644 index 0000000..aa7cb47 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_9.f08 @@ -0,0 +1,29 @@ +! { dg-do run } +! +! Contributed by Thomas Koenig , +! Andre Vehreschild + +program main + + type T + integer, allocatable :: acc(:) + end type + + integer :: n, lb, ub + integer :: vec(9) + type(T) :: o1, o2 + vec = [(i, i= 1, 9)] + n = 42 + lb = 7 + ub = lb + 2 + allocate(o1%acc, source=vec) + allocate(o2%acc, source=o1%acc(lb:ub)) + if (any (o2%acc /= [7, 8, 9])) call abort() + block + real, dimension(0:n) :: a + real, dimension(:), allocatable :: c + call random_number(a) + allocate(c,source=a(:)) + if (any (abs(a - c) > 1E-6)) call abort() + end block +end program main --MP_/eNyd/k5Wd6JNQU=Apl6Op4M--