From patchwork Mon Dec 28 15:55:57 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 561318 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 A744A140C60 for ; Tue, 29 Dec 2015 02:56:13 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=aLhbJbLW; 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:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=VVBMSijsOtsdbrh4QNfkOF6FG+lyFx9KeqDy2ueCHe9HMV0mqW 3vk5h7q5+QhPfO3JLOD6LfV2GgTSLREil5ME1o+sY/9gENMo3tkEGkPe0pvIgu/A k22PDI+2F2QKp8UvS8d5Id2E+l20K5kFz4g8wbaP+KFW9DhqVmo71qP7o= 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:mime-version:content-type; s= default; bh=rWsiQ9fwOPZAb6pDW1jWjwCjer8=; b=aLhbJbLWkDg5AFlRsum+ ESY1/rdzXz5VrHK+PVkmhnI1dJjBdGeHLciidczeXA/e7cYbW45x8zdFz+VXwAL1 fOX3NjHtUEm3QLZn4y5DS2kz5HqPuSqOqLu6v6VDSzmdaW0HBtCe+8koFjMwm8NZ HurMZmpUxiPsQ29dwPr61Og= Received: (qmail 106694 invoked by alias); 28 Dec 2015 15:56:05 -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 105769 invoked by uid 89); 28 Dec 2015 15:56:04 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.2 spammy=H*F:D*gmx.de, preventing, abstract, tstype X-Spam-User: qpsmtpd, 3 recipients X-HELO: mout.gmx.net Received: from mout.gmx.net (HELO mout.gmx.net) (212.227.15.19) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-GCM-SHA384 encrypted) ESMTPS; Mon, 28 Dec 2015 15:56:02 +0000 Received: from vepi2 ([92.213.0.123]) by mail.gmx.com (mrgmx002) with ESMTPSA (Nemesis) id 0LztD9-1a9XXZ2UMt-0154IC; Mon, 28 Dec 2015 16:55:58 +0100 Date: Mon, 28 Dec 2015 16:55:57 +0100 From: Andre Vehreschild To: GCC-Patches-ML , GCC-Fortran-ML Cc: vries@gcc.gnu.org Subject: [Patch, pr69011, fortran, v1] [6 Regression] [OOP] ICE in gfc_advance_chain for ALLOCATE with SOURCE Message-ID: <20151228165557.304669c8@vepi2> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:NVHKdMnta4s=:GkdO6KrIw1k/cXD1CW7DP2 KR9ZG8LY3yT4p2szFoa9gvABlaQ2jXYDzvJD/5TvnL6B/HxKsnsQkAW/eQ58dw3vHKb1y0VHp Dxm9XS7uLIpLuGCHQGs9Jq/uQw5h2p2CgODVOsYxaDosiX+gjFYzehenf7akl7nI/Kzdshc8f R0DKjhJDMf0TpN8CoVNpPgRf96qCEoId8twigJim2rEsBzpo3SwoP6KdKLyx5hzvx0gUv6A8r 1AZV2OrxCW1C+uxD5lP4B9FIMkcyxvysSmXufmhypvBVzeEiOoRrTnB/DMfDTBGwX/btEoA1g tjfExfiK9MxUVh1kmaXxogFUkusRkiAFrgmbCvKlMYZ+NYhCXqgfxOBMGhIu2Vx5q3n1AyxJQ IcIOXcYVlPLjUFiMS1a/lkJQoEZ1PU2oTBbvf4Po3vfN0Nj6i275W6omlluHAB+kLjwMw2hux pSoPdHEC9Spj3Rofaee34dgmET7r9nTV0H1VAjeFjqixGdoBSL52hA6LISryKU/s/ZZxk2V/S xZ6HEjGZ+RyTs+vM6qBeRAAPh3i8iKBNa4VDFSQVYikYSUeMI172q/mgdHcmIFfU8uBBbcpAi 30+jhsE68OlGldJHmOSEU+RhxyxTESiqwscWFihePAx0hdGAWu30hHd8IwW4QYh9dcirB4xus 2PW2vVxvyPzHdll9VH3DjUiObsPRN3AJ9dvrbFLPulE9r21A+2DAcy4sOE4lnqiRe6n5TRd/U QxU5TzdEcA3nIxtMF601CMIx+Z1eN2SADUXEWJzGjgJOiQjF1XBx4pd4bVA= Hi all, for bug pr69011 I like to propose the attached patch. The patch fixes the ICE and furthermore makes sure, that for this case of referencing a polymorphic object the correct vtype is selected. Previously the declared vtype of the source=-expression was taken for the object(s) to allocate. Now the actual vtype is taken, i.e., the vptr component of source='s object is taken. This is important when source references a subclass. Bootstrapped and regtested ok on x86_64-pc-linux-gnu/f23. Ok for trunk? Regards, Andre diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 72416d4..3c6fae1 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5377,7 +5377,20 @@ gfc_trans_allocate (gfc_code * code) if (code->ext.alloc.arr_spec_from_expr3 || code->expr3->rank != 0) gfc_conv_expr_descriptor (&se, code->expr3); else - gfc_conv_expr_reference (&se, code->expr3); + { + gfc_conv_expr_reference (&se, code->expr3); + + /* gfc_conv_expr_reference wraps POINTER_PLUS_EXPR in a + NOP_EXPR, which prevents gfortran from getting the vptr + from the source=-expression. Remove the NOP_EXPR and go + 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))) + se.expr = TREE_OPERAND (se.expr, 0); + } /* Create a temp variable only for component refs to prevent having to go through the full deref-chain each time and to simplfy computation of array properties. */ @@ -5494,7 +5507,6 @@ gfc_trans_allocate (gfc_code * code) expr3 may be a temporary array declaration, therefore check for GFC_CLASS_TYPE_P before trying to get the _vptr component. */ if (tmp != NULL_TREE - && TREE_CODE (tmp) != POINTER_PLUS_EXPR && (e3_is == E3_DESC || (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) && (VAR_P (tmp) || !code->expr3->ref)) diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 new file mode 100644 index 0000000..cb5f16f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! Test the fix for pr69011, preventing an ICE and making sure +! that the correct dynamic type is used. +! +! Contributed by Thomas Koenig +! Andre Vehreschild +! + +module m1 +implicit none +private +public :: basetype + +type:: basetype + integer :: i + contains +endtype basetype + +abstract interface +endinterface + +endmodule m1 + +module m2 +use m1, only : basetype +implicit none +integer, parameter :: I_P = 4 + +private +public :: factory, exttype + +type, extends(basetype) :: exttype + integer :: i2 + contains +endtype exttype + +type :: factory + integer(I_P) :: steps=-1 + contains + procedure, pass(self), public :: construct +endtype factory +contains + + function construct(self, previous) + class(basetype), intent(INOUT) :: previous(1:) + class(factory), intent(IN) :: self + class(basetype), pointer :: construct + allocate(construct, source=previous(self%steps)) + endfunction construct +endmodule m2 + + use m2 + use m1 + class(factory), allocatable :: c1 + class(exttype), allocatable :: prev(:) + class(basetype), pointer :: d + + allocate(c1) + allocate(prev(2)) + prev(:)%i = [ 2, 3] + prev(:)%i2 = [ 5, 6] + c1%steps= 1 + d=> c1%construct(prev) + + if (.not. associated(d) ) call abort() + select type (d) + class is (exttype) + if (d%i2 /= 5) call abort() + class default + call abort() + end select + if (d%i /= 2) call abort() + deallocate(c1) + deallocate(prev) + deallocate(d) +end