From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 80299 invoked by alias); 12 Oct 2016 09:50:26 -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 80274 invoked by uid 89); 12 Oct 2016 09:50:25 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.4 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 spammy=daan, circumvent, Needed, neatly 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; Wed, 12 Oct 2016 09:50:15 +0000 Received: from vepi2 ([84.63.206.51]) by mail.gmx.com (mrgmx003) with ESMTPSA (Nemesis) id 0LaFmY-1b8aUv2Jh8-00m5HG; Wed, 12 Oct 2016 11:50:12 +0200 Date: Wed, 12 Oct 2016 09:50:00 -0000 From: Andre Vehreschild To: GCC-Fortran-ML , GCC-Patches-ML Subject: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions Message-ID: <20161012115010.3f900f33@vepi2> In-Reply-To: <20160902095919.6feaefb5@vepi2> References: <20160902095919.6feaefb5@vepi2> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/auIa4WE0TG00FOWimbzjLuY" X-UI-Out-Filterresults: notjunk:1;V01:K0:LeUhyrV49SM=:Fw/Nx0c1FKm41oMHy95OPi VCq01YSRfXZ6VtiuArjYYLBY7T3CzvFOMPNgt0hc7bsh4KcWFiUZU/FOm5WKW6P+XrbZOLh6J 9F0BZ+35DPjNxEEoyut846dzd6RCXJyGoxMGh96N4+7PfngKgxL0/cjWs0zKIruCbqTibkyfO wMIvx+Fbw4hLW+Npq4Hz+8woOIVdDjs0mc/xpL5KqHHZcjEmNlORy26Ur//1L43QZ/Ds7Bzmy odMWCNM5ze/gPbAhW1DYlGFBzGtfPtIlqtI5tZUzHjhc40jUHvRjTyQgEy+YwFD++xV9KCPC6 Adw+Ap0m42Nl98vUwiEGuSkgvVxVFCxt6MYIJDTlSJmGGGYzYeSr8jiBQjDc+CmZILzhIc1J6 DPLwMjtJCHgF+yCdKQl2P/571+iguw/ctFvEt6lA7Y543Z3EkyVjm1H0P4BzE3nZZ1+fxoCxp X9rSG+sQ4u8L74nPCCkoFTEjqpAyAllxgnUDSm9rZCRrctP3B/NNRQyAKymFTDWjk3xy/p2/9 J1pr9KiYWVhOnT4Vj6pwxyKNhii/VBhVgx+VQLCOtl6JGk0ri3WDVB+4wT74xH5vSwX4IuaSj UOe4EGwk8vM4u0b2N3REYEbLpAIt8KVtkbsTVgSD71+039SremXUw8Hn+T2+N3w79t6obz5TK Yq/0gl1YYiTcV7OJuLv86esh2sucSWL2AXHf/vMGL4b97sHN4vRvGLMUg/Yhj7SnA6F/ofIMV D6yoJIqIcKkw5od2JQhSor0R1GIdChPLpEYCjw7KN8pAF5sdXbKiD5XCWsU= X-SW-Source: 2016-10/txt/msg00833.txt.bz2 --MP_/auIa4WE0TG00FOWimbzjLuY Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 1892 Ping! Updated patch with the comments gotten so far. Ok for trunk? - Andre On Fri, 2 Sep 2016 09:59:19 +0200 Andre Vehreschild wrote: > Hi all, > > attached patch fixes the issue raised by PR72832. The issue was that > the array descriptor of the SOURCE= in an ALLOCATE () was used to > allocate an array object although an explicit array spec had been > given. > > The initial test showed a second issue when a class array was copied. > Compiling the code with -fcheck=bounds showed that no boundary check > was generated for class array copying using gfc_copy_class_to_class(). > I have added the generation of a runtime boundary check when the > -fcheck=bounds flag is set to locate the current issue. The test > allocate_with_source_23 is compiled with fcheck=bounds and fails as > expected ({ xfail *-*-* } set). > > Fixing the both issues unfortunately raised the next one, when trying > to get the size of a class array returned from a function (testcase: > allocate_with_source_11.f08). Here the issue was that for functions > returning class arrays gfc_conv_expr_descriptor () relied on the > descriptor being magicked into the scalarizer, which did not work in > this use case. Due to the first issue this bug did not raise beforehand. > Because I could not figure how to do it right in > gfc_conv_expr_descriptor (), I found a way to circumvent the issue by > getting the reference of the result of the function returning a class > array and massaging it to be ok for size (). This works quite neatly, > but may be someone with better knowledge of conv_expr_descriptor and > the scalarizer might want to fix it there. I suppose there are more > locations in the code, that work around this issue. > > Bootstrapped and regtests ok on x86_64-linux-gnu/F23 for trunk and > gcc-6. Ok for both? > > - Andre -- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/auIa4WE0TG00FOWimbzjLuY Content-Type: text/plain Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr72832_1.clog Content-length: 658 gcc/fortran/ChangeLog: 2016-09-01 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=. gcc/testsuite/ChangeLog: 2016-09-01 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. --MP_/auIa4WE0TG00FOWimbzjLuY Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=pr72832_2.patch Content-length: 6083 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 1de2818..5486ec6 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1237,6 +1237,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, @@ -1264,6 +1265,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 = "<>"; + 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. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index a499c32..9d5e33c 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6544,9 +6544,20 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) 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); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 9fdacc1..deeea2f 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5489,7 +5489,8 @@ gfc_trans_allocate (gfc_code * code) 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 diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 new file mode 100644 index 0000000..b8689f9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 @@ -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 + + diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 new file mode 100644 index 0000000..cfe8bd8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 @@ -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_/auIa4WE0TG00FOWimbzjLuY--