From patchwork Sun Apr 27 08:03:07 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 343126 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]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 373D51400C6 for ; Sun, 27 Apr 2014 18:03:31 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=GDOTVC+8EY0HtJgg+YKqr9mUAmYNKdvJede+itqen1AXK3 iwTW32C3tgK4E2Bn2ssFJsr7VC9TAIx+VcoTzXaI3PcGt9wtKDaGgM6GG+qx8uZe 8YtopXMr0fIf+HKB+Nl0MnbUzyUW92o+jvW7beN0T1bpJOdKxLOVYN2g1h+Vk= 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 :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=/bJbigdywzhR/9nPsRCuZyn/d18=; b=Hwv+/HMwb65cbRsXFynt 2R0CFdPN0SwdaXqkM6kJDFzQPmfaxAVx1qvUs9rpgAmzRSuKU+enU2eV91o1W8Xj 0Y7Urc13aKEca56iTbkVzsPRqhTknAgqGx+IaAc3iOrmWk28JbmGykH4blShGKvA OJ1UtxXWTP1fqfW5EUwCPAk= Received: (qmail 758 invoked by alias); 27 Apr 2014 08:03:15 -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 735 invoked by uid 89); 27 Apr 2014 08:03:13 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.0 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mx02.qsc.de Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Sun, 27 Apr 2014 08:03:12 +0000 Received: from tux.net-b.de (port-92-194-43-249.dynamic.qsc.de [92.194.43.249]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by mx02.qsc.de (Postfix) with ESMTPSA id 7526727689; Sun, 27 Apr 2014 10:03:08 +0200 (CEST) Message-ID: <535CB9BB.5090002@net-b.de> Date: Sun, 27 Apr 2014 10:03:07 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Thunderbird/24.3.0 MIME-Version: 1.0 To: gcc-patches , gfortran Subject: [Patch, Fortran] Fix handling of polymorphic coarrays and coarray components This is patch is the first change from Fortran-caf which I want to merge to the trunk; it only affects -fcoarray=lib. Build and regtested xon 86-64-gnu-linux. OK for the trunk? Tobias PS: I am currently looking at another issue with polymophic coarrays, which also affects -fcoarray=single; that issue I want to solve first on the trunk – and then merge into the branch. I might pick one or the other patch from the branch for the trunk, but the main work should first stabilize on the branch before I want to submit it to the trunk. 2014-04-27 Tobias Burnus * trans-expr.c (get_tree_for_caf_expr): Fix handling of polymorphic and derived-type coarrays. 2014-04-27 Tobias Burnus * gfortran.dg/coarray_poly_4.f90: New. * gfortran.dg/coarray_poly_5.f90: New. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d6f820c..f0e5b7d 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1387,25 +1387,42 @@ gfc_get_expr_charlen (gfc_expr *e) static tree get_tree_for_caf_expr (gfc_expr *expr) { - tree caf_decl = NULL_TREE; - gfc_ref *ref; + tree caf_decl; + bool found; + gfc_ref *ref; - gcc_assert (expr && expr->expr_type == EXPR_VARIABLE); - if (expr->symtree->n.sym->attr.codimension) - caf_decl = expr->symtree->n.sym->backend_decl; + gcc_assert (expr && expr->expr_type == EXPR_VARIABLE); - for (ref = expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT) - { + caf_decl = expr->symtree->n.sym->backend_decl; + gcc_assert (caf_decl); + if (expr->symtree->n.sym->ts.type == BT_CLASS) + caf_decl = gfc_class_data_get (caf_decl); + if (expr->symtree->n.sym->attr.codimension) + return caf_decl; + + /* The following code assumes that the coarray is a component reachable via + only scalar components/variables; the Fortran standard guarantees this. */ + + for (ref = expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + { gfc_component *comp = ref->u.c.component; - if (comp->attr.pointer || comp->attr.allocatable) - caf_decl = NULL_TREE; - if (comp->attr.codimension) - caf_decl = comp->backend_decl; - } - gcc_assert (caf_decl != NULL_TREE); - return caf_decl; + if (POINTER_TYPE_P (TREE_TYPE (caf_decl))) + caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl); + caf_decl = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp->backend_decl), caf_decl, + comp->backend_decl, NULL_TREE); + if (comp->ts.type == BT_CLASS) + caf_decl = gfc_class_data_get (caf_decl); + if (comp->attr.codimension) + { + found = true; + break; + } + } + gcc_assert (found && caf_decl); + return caf_decl; } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 new file mode 100644 index 0000000..ceb1c85 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } + +subroutine test(i) +type t + real, allocatable :: x[:] +end type t + +interface + subroutine sub(y) + import + real :: y[*] + end subroutine sub +end interface + +integer :: i +type(t), save :: var +allocate(var%x[*]) +call sub(var%x) +end subroutine test + +! { dg-final { scan-tree-dump-times "sub \\(\\(real\\(kind=4\\) \\*\\) var.x.data, var.x.token, 0\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 new file mode 100644 index 0000000..29c9c8c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-fcoarray=lib -fdump-tree-original" } + +subroutine test(x) +type t + real, allocatable :: x[:] +end type t + +class(t) :: x +allocate(x%x[*]) +end subroutine test + +! { dg-final { scan-tree-dump-times "x->_data->x.data = _gfortran_caf_register \\(4, 1, &x->_data->x.token, 0B, 0B, 0\\);" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }