From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 45019 invoked by alias); 13 Oct 2016 08:53:24 -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 44985 invoked by uid 89); 13 Oct 2016 08:53:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=no version=3.3.2 spammy=nicht, Arbeitskopie, arbeitskopie, mature X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 13 Oct 2016 08:53:13 +0000 Received: from vepi2 ([84.63.206.51]) by mail.gmx.com (mrgmx002) with ESMTPSA (Nemesis) id 0Lbuo0-1bBggT2aTU-00jILi; Thu, 13 Oct 2016 10:53:01 +0200 Date: Thu, 13 Oct 2016 08:53:00 -0000 From: Andre Vehreschild To: Steve Kargl Cc: GCC-Fortran-ML , GCC-Patches-ML Subject: Re: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions Message-ID: <20161013105259.689a4b60@vepi2> In-Reply-To: <20161012171829.GA74545@troutmask.apl.washington.edu> References: <20160902095919.6feaefb5@vepi2> <20161012115010.3f900f33@vepi2> <20161012171829.GA74545@troutmask.apl.washington.edu> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/jhN/4UzTXSQ1q1JLATDd4Fs" X-UI-Out-Filterresults: notjunk:1;V01:K0:TzZwv66gUkQ=:G79ej4WJzf31UZgwa7w5nq pYlamJNpVrOKbC0MWiY3T0fTV5DCe574lL9aKbPfM+VqoFl0RBrMwek+jS7q3+lQitJcrZKUM pdBefuIDv2SHxfS0bHiRO37uza4IQrxmO95JviY0x10w3b0JsgU3JAMVyACp4WS555ehvhdEZ pUsNQpR/m5DJiPOOY4NssBkNMiVVlxThD2B5nIUaqKswNnS9KqggdQhvmSW1vaa9hQFGPZOAG ALxC1tgpfkSg/XUL7OViJkeiIp3UM1auRUUKJLZPr7grbfaQ63JljbcmoCy7iU7YTpznD17R4 x8DS0785+f7Ysjx2xJzF2jCElXygeR4Y9k2U8q2SmgGzV82VmwY4UXO1HNnahO5cO70h9N6Nm d2OqPeSU5NyvUj2mIPKVNxHZH1MoCxQ6ZBcFu+frRcvqM1YUZ8h8wSnms0Sixllug4eswjDtH z+jjjbUys6Bap8hpznYCdQMQyRd3k051ifLPj3tmBTSBm/mm4Zv0ZFLhgWxEoBhBJowlJDy7A 3SMZYUWbn+5ZW9ueU45w2ryMflAnkflx0AfQhwBpPgaixzOpaS+kPpyqgoqPxvP8joRlx4/GZ K9M+lDq5+A4o278dCuwNeM86VIYPVWP+6TEaLb1bHoZ0uVwYUiFS3TOEGGuAdWE3YeLzNs0Jl NjjgCYYwM2mMsvMKx9jhy6yFmNrD3Q7cR7bQRAgfj720DGAtPH5bqGd8HZ684Vrjwt6cMq9TD 9OQMI5s0sjwHkmTp0Gk2rS32+XR9WAdQK5QwnvcVCfSZTszqGSaY/rd1In4= X-SW-Source: 2016-10/txt/msg00989.txt.bz2 --MP_/jhN/4UzTXSQ1q1JLATDd4Fs Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 488 Hi Steve, thanks for the review. Committed as r241088 on trunk. Letting it mature for one week in trunk before backporting to gcc-6. Regards, Andre On Wed, 12 Oct 2016 10:18:29 -0700 Steve Kargl wrote: > On Wed, Oct 12, 2016 at 11:50:10AM +0200, Andre Vehreschild wrote: > > Ping! > > > > Updated patch with the comments gotten so far. > > > > Ok for trunk? > > > > Looks good to me. > -- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/jhN/4UzTXSQ1q1JLATDd4Fs Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=submit.diff Content-length: 7284 Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 241086) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,13 @@ +2016-10-13 Andre Vehreschild + + 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=. + 2016-10-12 Andre Vehreschild * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Fixed style. Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 241086) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1235,6 +1235,7 @@ 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 @@ } 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 = "<>"; + 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. */ Index: gcc/fortran/trans-intrinsic.c =================================================================== --- gcc/fortran/trans-intrinsic.c (Revision 241086) +++ gcc/fortran/trans-intrinsic.c (Arbeitskopie) @@ -6544,9 +6544,20 @@ if (actual->expr->ts.type == BT_CLASS) gfc_add_class_array_ref (actual->expr); - argse.want_pointer = 1; argse.data_not_needed = 1; - gfc_conv_expr_descriptor (&argse, actual->expr); + if (gfc_is_alloc_class_array_function (actual->expr)) + { + /* For functions that return a class array conv_expr_descriptor is not + able to get the descriptor right. Therefore this special case. */ + gfc_conv_expr_reference (&argse, actual->expr); + argse.expr = gfc_build_addr_expr (NULL_TREE, + gfc_class_data_get (argse.expr)); + } + else + { + argse.want_pointer = 1; + gfc_conv_expr_descriptor (&argse, actual->expr); + } gfc_add_block_to_block (&se->pre, &argse.pre); gfc_add_block_to_block (&se->post, &argse.post); arg1 = gfc_evaluate_now (argse.expr, &se->pre); Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (Revision 241086) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5489,7 +5489,8 @@ desc = tmp; tmp = gfc_class_data_get (tmp); } - e3_is = E3_DESC; + if (code->ext.alloc.arr_spec_from_expr3) + e3_is = E3_DESC; } else desc = !is_coarray ? se.expr Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 241086) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,10 @@ +2016-10-13 Andre Vehreschild + + PR fortran/72832 + * gfortran.dg/allocate_with_source_22.f03: New test. + * gfortran.dg/allocate_with_source_23.f03: New test. Expected to + fail. + 2016-10-13 Thomas Preud'homme * gcc.target/arm/movhi_movw.c: Enable test for ARM mode. Index: gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 (nicht existent) +++ gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 (Arbeitskopie) @@ -0,0 +1,48 @@ +! { dg-do run } +! +! Test that pr72832 is fixed now. +! Contributed by Daan van Vugt + +program allocate_source + type :: t + integer :: i + end type t + type, extends(t) :: tt + end type tt + + call test_type() + call test_class() + +contains + +subroutine test_class() + class(t), allocatable, dimension(:) :: a, b + allocate(tt::a(1:2)) + a(:)%i = [ 1,2 ] + if (size(a) /= 2) call abort() + if (any(a(:)%i /= [ 1,2])) call abort() + + allocate(b(1:4), source=a) + ! b is incorrectly initialized here. This only is diagnosed when compiled + ! with -fcheck=bounds. + if (size(b) /= 4) call abort() + if (any(b(1:2)%i /= [ 1,2])) call abort() + select type (b(1)) + class is (tt) + continue + class default + call abort() + end select +end subroutine + +subroutine test_type() + type(t), allocatable, dimension(:) :: a, b + allocate(a(1:2)) + if (size(a) /= 2) call abort() + + allocate(b(1:4), source=a) + if (size(b) /= 4) call abort() +end subroutine +end program allocate_source + + Index: gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 (nicht existent) +++ gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 (Arbeitskopie) @@ -0,0 +1,67 @@ +! { dg-do run } +! { dg-options "-fcheck=bounds" } +! { dg-shouldfail "Array bounds mismatch" } +! +! Test that pr72832 is fixed now. +! Contributed by Daan van Vugt + +program allocate_source + type :: t + integer :: i + end type t + type, extends(t) :: tt + end type tt + + call test_type() + call test_class_correct() + call test_class_fail() + +contains + +subroutine test_class_correct() + class(t), allocatable, dimension(:) :: a, b + allocate(tt::a(1:2)) + a(:)%i = [ 1,2 ] + if (size(a) /= 2) call abort() + if (any(a(:)%i /= [ 1,2])) call abort() + + allocate(b(1:4), source=a(1)) + if (size(b) /= 4) call abort() + if (any(b(:)%i /= [ 1,1,1,1])) call abort() + select type (b(1)) + class is (tt) + continue + class default + call abort() + end select +end subroutine + +subroutine test_class_fail() + class(t), allocatable, dimension(:) :: a, b + allocate(tt::a(1:2)) + a(:)%i = [ 1,2 ] + if (size(a) /= 2) call abort() + if (any(a(:)%i /= [ 1,2])) call abort() + + allocate(b(1:4), source=a) ! Fail expected: sizes do not conform + if (size(b) /= 4) call abort() + if (any(b(1:2)%i /= [ 1,2])) call abort() + select type (b(1)) + class is (tt) + continue + class default + call abort() + end select +end subroutine + +subroutine test_type() + type(t), allocatable, dimension(:) :: a, b + allocate(a(1:2)) + if (size(a) /= 2) call abort() + + allocate(b(1:4), source=a) + if (size(b) /= 4) call abort() +end subroutine +end program allocate_source + + --MP_/jhN/4UzTXSQ1q1JLATDd4Fs--