From patchwork Wed May 30 16:35:35 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 162031 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 550FBB706E for ; Thu, 31 May 2012 02:36:07 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1339000585; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=9ak0KhX gFKUss3zehDTEHXK4VlY=; b=dQetz8umGvalDNEslMrmzr2vrSutdYGj7PrVbMT +lAe0td0GPXMobh1dFBphFPcR+mXmp1JYiqXlbEG6+hFD8be+irG8pIb428RslsH H4JOk9iJ6ZVH4tZ/odJwlI1AHHBEvC6Qn8btkVvVz9gFjnMv1nU221bGfTbCyy3z 8xKU= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=EeIb7wYi4s24Q0kY2qXK8htaUr2+TiqfWLRbM82Fh5/uKTZh5nS1Ppkl+RkC7+ LWfnE3Qsw2zeyex7DGgaEwDZLhheYrR/Wus1Jzl4CnMEHdRu8CmArrIbT2tVsB6k n0xP50majatm3fqz0dH+xCVQ53Y1JubL4YWh+Za/IwyD0=; Received: (qmail 5077 invoked by alias); 30 May 2012 16:36:02 -0000 Received: (qmail 4933 invoked by uid 22791); 30 May 2012 16:35:59 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 30 May 2012 16:35:45 +0000 Received: from [192.168.178.22] (port-92-204-84-204.dynamic.qsc.de [92.204.84.204]) by mx02.qsc.de (Postfix) with ESMTP id 5D817280CE; Wed, 30 May 2012 18:35:38 +0200 (CEST) Message-ID: <4FC64C57.5060504@net-b.de> Date: Wed, 30 May 2012 18:35:35 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:12.0) Gecko/20120428 Thunderbird/12.0.1 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR53526 - Fix MOVE_ALLOC for coarrays 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 This patch is related to today's check.c patch, but independent (also order wise). The patch ensures that for scalar coarrays, the array path is taken in trans-intrinsic. Thus, "to->data = from->data" gets replaced by "*to = *from" such that the array bounds (and with -fcoarray=lib the token) gets transferred as well. While that also affected -fcoarray=single, the main changes are for the lib version: - Call deregister instead of free - Call sync all if TO is not deregistered. (move_alloc is an image control statement and, thus, implies synchronization) Build and regtested on x86-64-linux. OK for the trunk? Tobias 2012-05-30 Tobias Burnus PR fortran/53526 * trans-intrinsic.c (conv_intrinsic_move_alloc): Handle coarrays. 2012-05-30 Tobias Burnus PR fortran/53526 * gfortran.dg/coarray_lib_move_alloc_1.f90: New. * gfortran.dg/coarray/move_alloc_1.f90 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 04d6caa..8cce427 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -7243,6 +7243,7 @@ conv_intrinsic_move_alloc (gfc_code *code) gfc_se from_se, to_se; gfc_ss *from_ss, *to_ss; tree tmp; + bool coarray; gfc_start_block (&block); @@ -7254,8 +7255,9 @@ conv_intrinsic_move_alloc (gfc_code *code) gcc_assert (from_expr->ts.type != BT_CLASS || to_expr->ts.type == BT_CLASS); + coarray = gfc_get_corank (from_expr) != 0; - if (from_expr->rank == 0) + if (from_expr->rank == 0 && !coarray) { if (from_expr->ts.type != BT_CLASS) from_expr2 = from_expr; @@ -7366,15 +7368,50 @@ conv_intrinsic_move_alloc (gfc_code *code) } /* Deallocate "to". */ - to_ss = gfc_walk_expr (to_expr); - from_ss = gfc_walk_expr (from_expr); + if (from_expr->rank != 0) + { + to_ss = gfc_walk_expr (to_expr); + from_ss = gfc_walk_expr (from_expr); + } + else + { + to_ss = walk_coarray (to_expr); + from_ss = walk_coarray (from_expr); + } gfc_conv_expr_descriptor (&to_se, to_expr, to_ss); gfc_conv_expr_descriptor (&from_se, from_expr, from_ss); - tmp = gfc_conv_descriptor_data_get (to_se.expr); - tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE, - NULL_TREE, true, to_expr, false); - gfc_add_expr_to_block (&block, tmp); + /* For coarrays, call SYNC ALL if TO is already deallocated as MOVE_ALLOC + is an image control "statement", cf. IR F08/0040 in 12-006A. */ + if (coarray && gfc_option.coarray == GFC_FCOARRAY_LIB) + { + tree cond; + + tmp = gfc_deallocate_with_status (to_se.expr, NULL_TREE, NULL_TREE, + NULL_TREE, NULL_TREE, true, to_expr, + true); + gfc_add_expr_to_block (&block, tmp); + + tmp = gfc_conv_descriptor_data_get (to_se.expr); + cond = fold_build2_loc (input_location, EQ_EXPR, + boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all, + 3, null_pointer_node, null_pointer_node, + build_int_cst (integer_type_node, 0)); + + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, + tmp, build_empty_stmt (input_location)); + gfc_add_expr_to_block (&block, tmp); + } + else + { + tmp = gfc_conv_descriptor_data_get (to_se.expr); + tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE, + NULL_TREE, true, to_expr, false); + gfc_add_expr_to_block (&block, tmp); + } /* Move the pointer and update the array descriptor data. */ gfc_add_modify_loc (input_location, &block, to_se.expr, from_se.expr); --- /dev/null 2012-05-29 08:59:25.267676082 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_move_alloc_1.f90 2012-05-30 17:06:30.000000000 +0200 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } +! +! PR fortran/53526 +! +! Check handling of move_alloc with coarrays + +subroutine ma_scalar (aa, bb) + integer, allocatable :: aa[:], bb[:] + call move_alloc(aa,bb) +end + +subroutine ma_array (cc, dd) + integer, allocatable :: cc(:)[:], dd(:)[:] + call move_alloc (cc, dd) +end + +! { dg-final { scan-tree-dump-times "free" 0 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_all" 2 "original" } } +! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } } +! { dg-final { scan-tree-dump-times "\\*bb = \\*aa" 1 "original" } } +! { dg-final { scan-tree-dump-times "\\*dd = \\*cc" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } --- /dev/null 2012-05-29 08:59:25.267676082 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray/move_alloc_1.f90 2012-05-30 17:08:30.000000000 +0200 @@ -0,0 +1,24 @@ +! { dg-do run } +! +! PR fortran/53526 +! +! Check handling of move_alloc with coarrays +! +implicit none +integer, allocatable :: u[:], v[:], w(:)[:,:], x(:)[:,:] + +allocate (u[4:*]) +call move_alloc (u, v) +if (allocated (u)) call abort () +if (lcobound (v, dim=1) /= 4) call abort () +if (ucobound (v, dim=1) /= 3 + num_images()) call abort () + +allocate (w(-2:3)[4:5,-1:*]) +call move_alloc (w, x) +if (allocated (w)) call abort () +if (lbound (x, dim=1) /= -2) call abort () +if (ubound (x, dim=1) /= 3) call abort () +if (any (lcobound (x) /= [4, -1])) call abort () +if (any (ucobound (x) /= [5, -2 + (num_images()+1)/2])) call abort () + +end