From patchwork Sun Oct 23 11:57:01 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 78824 Delivered-To: patch@linaro.org Received: by 10.140.97.247 with SMTP id m110csp2109629qge; Sun, 23 Oct 2016 04:57:42 -0700 (PDT) X-Received: by 10.98.26.205 with SMTP id a196mr18850644pfa.50.1477223862275; Sun, 23 Oct 2016 04:57:42 -0700 (PDT) Return-Path: Received: from sourceware.org (server1.sourceware.org. [209.132.180.131]) by mx.google.com with ESMTPS id yv4si9016573pab.56.2016.10.23.04.57.41 for (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sun, 23 Oct 2016 04:57:42 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-return-439328-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) client-ip=209.132.180.131; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org; spf=pass (google.com: domain of gcc-patches-return-439328-patch=linaro.org@gcc.gnu.org designates 209.132.180.131 as permitted sender) smtp.mailfrom=gcc-patches-return-439328-patch=linaro.org@gcc.gnu.org DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=Lk/6xbQXeMODIkMJ KVdXBAWBOv2bhwnpsWmm9M0rk0Ko2sctXOTw39oxcLcV8fjMmhL2ptUHpjwDYJTa d/ktvbCLeqkaXkPdIFyayYHSHFC9+dvJS3cPiAlTZ0CGNiO/nsOmtQngC9oVNEwD TrrjvciALUSBoWNGBU6ZpdFAnN8= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:in-reply-to:references :mime-version:content-type; s=default; bh=mE0pBHeHWwSPYNW5EDm+w7 4lgEg=; b=mncaOVS2VTcCwvxPQp70XHZtfjLhTxaAI3eZnQEIiIxyYhoIuZI0Qz wus4EM9km7md5xfhaoidTOopyoTIzEQN4TNcKkaHZNwFGCIpiIcbb2NgbdOIbJbE oyrLoQQe/NFb/IRvfLYsxhHiDeQ4E8z1VaMQ5s7j/vD96FPFAAGuA= Received: (qmail 39449 invoked by alias); 23 Oct 2016 11:57:26 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 39430 invoked by uid 89); 23 Oct 2016 11:57:25 -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, 11936, U*kargl, existent X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.17.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 23 Oct 2016 11:57:15 +0000 Received: from vepi2 ([84.63.206.51]) by mail.gmx.com (mrgmx101) with ESMTPSA (Nemesis) id 0Ld4xA-1cg6Xg06Ea-00iFxv; Sun, 23 Oct 2016 13:57:04 +0200 Date: Sun, 23 Oct 2016 13:57:01 +0200 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: <20161023135701.6f3e5999@vepi2> In-Reply-To: <20161013105259.689a4b60@vepi2> References: <20160902095919.6feaefb5@vepi2> <20161012115010.3f900f33@vepi2> <20161012171829.GA74545@troutmask.apl.washington.edu> <20161013105259.689a4b60@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:JE/URbELSUs=:Id9jAfmMI5rYJNWBSCIxzR tavmlE+IYIMXc4EVrhtfMnHcR4+EB9aJxJiZPaEXIq+VGvRNV79uHmaX0jiTFeu/f1jDmI2AT Pszbbu+Wf8jGa5StsOPcGuN0vM2+RiCpK5gfkHWg+M+3GA6MwZZoMMD1jmadMEVLXEMknJl19 JhyHQbXxIG+hgU/bHERsk/upRtI06NLMRk94Q+3SrbQOLILg3jwlIhV9f8r9sDu+/0OSVwM9M FJ9nnqztyjk9tzPNo3T+mte8SSrujtTf1aTCm8QgIyDIQMlp9oGFDDRUSDE4n2kcl9jSvvZTt yRd5gq6BonwdkF3cJiLN+gwSb0ozFD+eNbKevhj2lICvKrVkZFs0aOOqmFCDLruFvmDRzhxU0 /F37xjERWrh50my1tHRzIN4U+eSI99gorau3vty6KK0EgQ22X+28dlJmlZI8WWJxOU+dFdmzT IMsm7SUDZNt8oR0b9bwAa55ekiUbH9lN9/5MrDMG0HT0LQHUQ4s2j+fWZhnilCAK4ic8QVoeW pHXnzFXF7BKqxR0j+wh4CiqmMsujbRGfQaFjO6r+UlonhRdXTUAk8vIiYqTBIpIo2WVSyVyIb V1vp0DJOVft+vj2A9JFrH+bIU2gipHFa12986nBNstdgYIYKgtIsBWhOozhx6PWj/LftmMBXE dQmtJrg8RGMdipQ5rdrvObHJHUx2f/I/89Aghn2WTM+L/UFHLOV81JU16ZYsvtsK6oQCCDy1F 9B7FV3nfdT7gGFJxjqMkFVfNP+cq110v0csKaWhDvdAdqnWErKSODdV7w8s= Hi all, due to no complains about the trunk version, backported to gcc-6 as r241448. Regards, Andre On Thu, 13 Oct 2016 10:52:59 +0200 Andre Vehreschild wrote: > 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 Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 241447) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,3 +1,14 @@ +2016-10-23 Andre Vehreschild + + Backported from trunk + 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-17 Steven G. Kargl Backport from trunk Index: gcc/fortran/trans-expr.c =================================================================== --- gcc/fortran/trans-expr.c (Revision 241447) +++ gcc/fortran/trans-expr.c (Arbeitskopie) @@ -1166,6 +1166,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, @@ -1193,6 +1194,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 241447) +++ gcc/fortran/trans-intrinsic.c (Arbeitskopie) @@ -5815,9 +5815,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 241447) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5476,7 +5476,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 241447) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,3 +1,11 @@ +2016-10-23 Andre Vehreschild + + Backported from trunk + 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-19 Uros Bizjak PR target/77991 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 + +