From patchwork Fri Jan 29 18:17:24 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 575790 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 04772140BF7 for ; Sat, 30 Jan 2016 05:17:40 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=yTLKBYPK; dkim-atps=neutral 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:subject:message-id:mime-version:content-type; q=dns; s= default; b=hsgulnMnfUO/l9CS/aF1GKtBVRuve7HPTpFIuXKZac2JPTFZlC8r9 0JBXWsv92NWGHnMFrBVr9fUpl4rE3+fCfMjXK/LqsaIReoIT5VbRplVJ7p/QRJ0c cYskvhPYTnPwUwehK4eV+8aYcdYDbvjaa3Yh5zbHYwGixrRVrtQO2M= 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:subject:message-id:mime-version:content-type; s= default; bh=AaBNeq8Y7ILGvJHeV+6WFhldpNE=; b=yTLKBYPK44jnn/B/pE/0 2aWH78++8oIjph4m9Bqeq426/ZEakXjIqEI/6HSPmqpI3lJUwgSf2V1bv1LXpNuR wDt4xxNsNhYgZDXcp2xqpdpGxQ1n58vCp2mTS2ag1vVH/AGjy2NttFk9Qx4J0xjm vgVdKEZD/UotH1RjBv+e8LA= Received: (qmail 94994 invoked by alias); 29 Jan 2016 18:17:32 -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 94965 invoked by uid 89); 29 Jan 2016 18:17:31 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.0 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:build_f, 1, 43, 1, 28, fcoarray X-Spam-User: qpsmtpd, 2 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.18) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Fri, 29 Jan 2016 18:17:29 +0000 Received: from vepi2 ([92.213.0.123]) by mail.gmx.com (mrgmx002) with ESMTPSA (Nemesis) id 0MJSLz-1aMBjy3yDD-0033e6; Fri, 29 Jan 2016 19:17:26 +0100 Date: Fri, 29 Jan 2016 19:17:24 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Subject: [Patch, fortran, pr67451, v1] [5/6 Regression] ICE with sourced allocation from coarray Message-ID: <20160129191724.2eb47e1b@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:bpxpEy6n4ow=:3tJQmgBrQKXqpc/v0WWvss aq8iK91toiPUVXhkT0ont7/0p1VZE0NCmbfuh4L7MPj7CWxOzh2hWvZo8aUn4tbPgLqpvPTCf 1yn3wqC/jrg2zXn0vkLtzsv607s4z3QgRAy3nAt2XCC4n43D/GiOvZaOVK7TkScE0U26Wyr2W lb3GN9qpCUsFEDdE88xp2FZU+cmgjwgrRVed1TmA+jDKp6R4muWC7XmFxXIPItgwFQEtMnQBg EGDYRvjaFJUYZT17ktsow2kFggQrb2xzVYudXirU3UtEd/5/VZgVOCw7INVWM0CWF1cChSnA6 Is1yFUwCVHH/SRFnzXdu/i8xqBxrT5p0vkasAFzSMt2vE+UESRksake1Ay8otEyv8YccVFM5f M/ZgcA/wDm/sFAeoNSSl72AkqN9TXNXQmv31eMGiysKOh1AndnHrGht3UzFXm+JjEBrwBi41V o5kpHA1om2d74DRdHhKqm3BOg/GPh/XhLAA8dCau2qK3DLYyPWCQLQeai4zWLwFx52P7hoXTb rjSK3mttFkgyUU4GxV80oFEwFb4+3jUb0sVlLU+BUU5FV3x1zKRpj5WLDMsOO7kDvXlxQLZ8G Kv6jD1ncdVxHnmqWSBxkJ0v5ADNhSkqK4t5Jcn5EHE53HYLgFvoHU6K2LicOOAJLK5jU2TURs HF9YrMKwjU+00WI+12pKNiw+/1+JA2nrNR95GHMISj9amHLE1FkBpQwvUpxZh09L1ssvVzeoe yXlBkEBkNQgwJymyAEipZg1pLoJhfFhYYGfx2XqPJW1uZWsQkEkK8/5TILI= Hi all, attached is a patch to fix a regression in current gfortran when a coarray is used in the source=-expression of an allocate(). The ICE was caused by the class information, i.e., _vptr and so on, not at the expected place. The patch fixes this. The patch also fixes pr69418, which I will flag as a duplicate in a second. Bootstrapped and regtested ok on x86_64-linux-gnu/F23. Ok for trunk? Backport to gcc-5 is pending, albeit more difficult, because the allocate() implementation on 5 is not as advanced the one in 6. Regards, Andre diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index c5ae4c5..8f63d34 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1103,7 +1103,14 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited) } else { - from_data = gfc_class_data_get (from); + /* Check that from is a class. When the class is part of a coarray, + then from is a common pointer and is to be used as is. */ + tmp = POINTER_TYPE_P (TREE_TYPE (from)) + ? build_fold_indirect_ref (from) : from; + from_data = + (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) + || (DECL_P (tmp) && GFC_DECL_CLASS (tmp))) + ? gfc_class_data_get (from) : from; is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)); } } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 310d2cd..5143c31 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5358,7 +5358,8 @@ gfc_trans_allocate (gfc_code * code) expression. */ if (code->expr3) { - bool vtab_needed = false, temp_var_needed = false; + bool vtab_needed = false, temp_var_needed = false, + is_coarray = gfc_is_coarray (code->expr3); /* Figure whether we need the vtab from expr3. */ for (al = code->ext.alloc.list; !vtab_needed && al != NULL; @@ -5392,9 +5393,9 @@ gfc_trans_allocate (gfc_code * code) with the POINTER_PLUS_EXPR in this case. */ if (code->expr3->ts.type == BT_CLASS && TREE_CODE (se.expr) == NOP_EXPR - && TREE_CODE (TREE_OPERAND (se.expr, 0)) - == POINTER_PLUS_EXPR) - //&& ! GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))) + && (TREE_CODE (TREE_OPERAND (se.expr, 0)) + == POINTER_PLUS_EXPR + || is_coarray)) se.expr = TREE_OPERAND (se.expr, 0); } /* Create a temp variable only for component refs to prevent @@ -5435,7 +5436,7 @@ gfc_trans_allocate (gfc_code * code) if (se.expr != NULL_TREE && temp_var_needed) { tree var, desc; - tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ? + tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ? se.expr : build_fold_indirect_ref_loc (input_location, se.expr); @@ -5448,7 +5449,7 @@ gfc_trans_allocate (gfc_code * code) { /* When an array_ref was in expr3, then the descriptor is the first operand. */ - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray) { desc = TREE_OPERAND (tmp, 0); } @@ -5460,11 +5461,12 @@ gfc_trans_allocate (gfc_code * code) e3_is = E3_DESC; } else - desc = se.expr; + desc = !is_coarray ? se.expr + : TREE_OPERAND (TREE_OPERAND (se.expr, 0), 0); /* We need a regular (non-UID) symbol here, therefore give a prefix. */ var = gfc_create_var (TREE_TYPE (tmp), "source"); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray) { gfc_allocate_lang_decl (var); GFC_DECL_SAVED_DESCRIPTOR (var) = desc; diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 new file mode 100644 index 0000000..7a712a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Ian Harvey +! Extended by Andre Vehreschild +! to test that coarray references in allocate work now +! PR fortran/67451 + + program main + implicit none + type foo + integer :: bar = 99 + end type + class(foo), allocatable :: foobar[:] + class(foo), allocatable :: some_local_object + allocate(foobar[*]) + + allocate(some_local_object, source=foobar) + + if (.not. allocated(foobar)) call abort() + if (.not. allocated(some_local_object)) call abort() + + deallocate(some_local_object) + deallocate(foobar) + end program + diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 new file mode 100644 index 0000000..46f34c0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Ian Harvey +! Extended by Andre Vehreschild +! to test that coarray references in allocate work now +! PR fortran/67451 + + program main + implicit none + type foo + integer :: bar = 99 + end type + class(foo), dimension(:), allocatable :: foobar[:] + class(foo), dimension(:), allocatable :: some_local_object + allocate(foobar(10)[*]) + + allocate(some_local_object, source=foobar) + + if (.not. allocated(foobar)) call abort() + if (lbound(foobar, 1) /= 1 .OR. ubound(foobar, 1) /= 10) call abort() + if (.not. allocated(some_local_object)) call abort() + if (any(some_local_object(:)%bar /= [99, 99, 99, 99, 99, 99, 99, 99, 99, 99])) call abort() + + deallocate(some_local_object) + deallocate(foobar) + end program + diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 new file mode 100644 index 0000000..a36d796 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 @@ -0,0 +1,43 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Contributed by Gerhard Steinmetz +! Andre Vehreschild +! Check that PR fortran/69451 is fixed. + +program main + +implicit none + +type foo +end type + +class(foo), allocatable :: p[:] +class(foo), pointer :: r +class(*), allocatable, target :: z + +allocate(p[*]) + +call s(p, z) +select type (z) + class is (foo) + r => z + class default + call abort() +end select + +if (.not. associated(r)) call abort() + +deallocate(r) +deallocate(p) + +contains + +subroutine s(x, z) + class(*) :: x[*] + class(*), allocatable:: z + allocate (z, source=x) +end + +end +