From patchwork Sun Feb 5 15:44:59 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Andre Vehreschild X-Patchwork-Id: 724251 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 3vGZgm4h0Xz9s2Q for ; Mon, 6 Feb 2017 02:45:38 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="QKmFZs9P"; 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:in-reply-to:references :mime-version:content-type; q=dns; s=default; b=rwfEOiSqQR/LsZdy tx1xo6vFn4wyZs+zkKi979KRVqPYij+zi2077wxx+N3FoQcFRJ4YsDzJggp/R1zI mnP0ezCRikHEUpJG0tXSNsbZQKt1lfjbsnNmCQ5evgUjFfINecx8TkTsUn0sUtAm gat3RqqxclhvuHN3w8YDD1sHlGg= 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=GxzdvC0oxvF3HiCA3CBlD9 uXMxk=; b=QKmFZs9PvrjOkjLaVhFKwMRTfPeRLB6gznCaHGbJbm3Ujpv/5gYIFJ iax4fbn6FCg+PEs5Ggi8r9y+Y3GTsdUHpe035GgRig1GzQpeF3HN7FU6GT0kZsOQ sI5vxjQVmYCMRbGOYd7S7YVR7ifca/cxgoslrh8+OgD+h1bFfg/DA= Received: (qmail 100298 invoked by alias); 5 Feb 2017 15:45:31 -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 100250 invoked by uid 89); 5 Feb 2017 15:45:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=4.6 required=5.0 tests=AWL, BAYES_50, FREEMAIL_FROM, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_LOW, RCVD_IN_SORBS_WEB, SPF_PASS autolearn=no version=3.3.2 spammy=nicht, bootstraps, bt_class, BT_CLASS 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, 05 Feb 2017 15:45:16 +0000 Received: from vepi2 ([84.63.213.96]) by mail.gmx.com (mrgmx102 [212.227.17.168]) with ESMTPSA (Nemesis) id 0M1zFf-1cKF3W0qrb-00txk7; Sun, 05 Feb 2017 16:45:01 +0100 Date: Sun, 5 Feb 2017 16:44:59 +0100 From: Andre Vehreschild To: Mikael Morin Cc: GCC-Patches-ML , GCC-Fortran-ML , JRR Subject: Re: [PATCH, Fortran, pr79344, v1] [7 Regression] segmentation faults and run-time errors Message-ID: <20170205164459.4cc78a15@vepi2> In-Reply-To: <36ed5531-ad78-2a36-d1a7-88a0c3a80d40@orange.fr> References: <20170204194100.6baefa76@vepi2> <36ed5531-ad78-2a36-d1a7-88a0c3a80d40@orange.fr> MIME-Version: 1.0 X-UI-Out-Filterresults: notjunk:1; V01:K0:lQOdjfmm6oY=:s60XXAMcXQ2EO8PWsl5HS/ VWXS4sj1SAr+WBpKUn+oKoRs5C1CByOAPosHlCodvzjI/rDoH9fhlMW2Sf7GkveXx90trCOur hG9mS54sbLzAZiNqeXDMM4tF9KlNIinjCcx2vjuWDIOff+zhizZXUPA4Fu2HGFq0hsOFgOXDw fwj8h9Ecz0Afz5IPdaLkJiw6Mou7X5awaaBjGIa6cTywpziVdWSS63iiw6O3Rh7ozMhfUJVpa GaM8aGxwyuFz0qoPLdddldxO87E4y2X5EB31UkVMIDp3mP6B3vUdmCoUo830rCWCWS7BXu7/0 BRDLGfQxLhDrAf0zXu7JJdShf7+EkRfCPFjEkVNQoOI7SNZcnwqUbmKhkBY6ZPEP3obuIRwQS 5CGUp1dohV+sgT8B0rkuYOIiqs/7QgWMWCr+pQYofdFFCspWuS5m6Zj17f1Ows3xD5lB+nNwZ pEc6CRo9+GsjULd+Lo4zElatgDfglWx+6wXdOfXpFxFwuoYo+1DtaV0bylJJN/TRHsAZ7PxZu R2AaBDEhWcTKx7mi+CX1dPJUYJs/EIWWItM5bhpU6yoKiukVXMoFUa5fHoaWVtve0Cfm0BVFh 4WtFErmpwLAVXbhYFr6QeuL+busJMtF4gJGkrIQfziwRnM0WRC4loV8jAwpH1c5YETGg/+w1W 8bu5u/YVO9YHaUMMGXTLlUHdtNzptnQV8y8Zw167by9eT4ItXVwLAwdffVqHvngNGfTim5/Gh DHcUgU0NhvaewBBLe1J1pNK0X4mU7o2epp3Oq7EOGvn2U6auCGSWDbyG2EEM/vYokv8B/c4v9 H7wBOyW699FVxU5HSCsS7petWjcRwcaayPapKo3paPoa/wuvxebcSsImcILBHNMvIS4uM3o1g FHi0Ron2sm8kANp4Ca0SXWeuduAXrXo8ynNmVN1FO5bxE41LBUYblACK95++VD3A/EOR13QpO pxMwdMFvPMNZFeLeMJPXQU217g4inaXl66YF1oJERBa44OGPG/VoeSCHv5ntr1eIfu2dQdPW2 JQciZZB6TlcqHObXGwXZb9Kj4vLM9EHm0sK32JVA3uTg Hi Mikael, thanks for the fast review. Committed as r245193. Regards, Andre On Sun, 5 Feb 2017 15:32:25 +0100 Mikael Morin wrote: > Le 04/02/2017 à 19:43, Andre Vehreschild a écrit : > > Hi all, > > > > attached patch fixes the issue of losing the data in the SOURCE= expression > > of an ALLOCATE() when the source-expression is just a simple variable. The > > issue was that internally a temporary variable was created, whose > > components were freed afterwards. Now the components are only freed on > > temporary objects, i.e., when the source-expression is not an > > EXPR_VARIABLE, e.g. an EXPR_STRUCTURE or EXPR_FUNCTION. > > > > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? > > > Hello, > > this looks good to me. > Thanks > > Mikael > Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 245193) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,5 +1,10 @@ 2017-02-05 Andre Vehreschild + PR fortran/79344 + * gfortran.dg/allocate_with_source_24.f90: New test. + +2017-02-05 Andre Vehreschild + PR fortran/79230 * gfortran.dg/der_ptr_component_2.f90: New test. Index: gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 (nicht existent) +++ gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 (Revision 245194) @@ -0,0 +1,134 @@ +! { dg-do run } +! +! Test that the temporary in a sourced-ALLOCATE is not freeed. +! PR fortran/79344 +! Contributed by Juergen Reuter + +module iso_varying_string + implicit none + + type, public :: varying_string + private + character(LEN=1), dimension(:), allocatable :: chars + end type varying_string + + interface assignment(=) + module procedure op_assign_VS_CH + end interface assignment(=) + + interface operator(/=) + module procedure op_not_equal_VS_CA + end interface operator(/=) + + interface len + module procedure len_ + end interface len + + interface var_str + module procedure var_str_ + end interface var_str + + public :: assignment(=) + public :: operator(/=) + public :: len + + private :: op_assign_VS_CH + private :: op_not_equal_VS_CA + private :: char_auto + private :: len_ + private :: var_str_ + +contains + + elemental function len_ (string) result (length) + type(varying_string), intent(in) :: string + integer :: length + if(ALLOCATED(string%chars)) then + length = SIZE(string%chars) + else + length = 0 + endif + end function len_ + + elemental subroutine op_assign_VS_CH (var, exp) + type(varying_string), intent(out) :: var + character(LEN=*), intent(in) :: exp + var = var_str(exp) + end subroutine op_assign_VS_CH + + pure function op_not_equal_VS_CA (var, exp) result(res) + type(varying_string), intent(in) :: var + character(LEN=*), intent(in) :: exp + logical :: res + integer :: i + res = .true. + if (len(exp) /= size(var%chars)) return + do i = 1, size(var%chars) + if (var%chars(i) /= exp(i:i)) return + end do + res = .false. + end function op_not_equal_VS_CA + + pure function char_auto (string) result (char_string) + type(varying_string), intent(in) :: string + character(LEN=len(string)) :: char_string + integer :: i_char + forall(i_char = 1:len(string)) + char_string(i_char:i_char) = string%chars(i_char) + end forall + end function char_auto + + elemental function var_str_ (char) result (string) + character(LEN=*), intent(in) :: char + type(varying_string) :: string + integer :: length + integer :: i_char + length = LEN(char) + ALLOCATE(string%chars(length)) + forall(i_char = 1:length) + string%chars(i_char) = char(i_char:i_char) + end forall + end function var_str_ + +end module iso_varying_string + +!!!!! + +program test_pr79344 + + use iso_varying_string, string_t => varying_string + + implicit none + + type :: field_data_t + type(string_t), dimension(:), allocatable :: name + end type field_data_t + + type(field_data_t) :: model, model2 + allocate(model%name(2)) + model%name(1) = "foo" + model%name(2) = "bar" + call copy(model, model2) +contains + + subroutine copy(prt, prt_src) + implicit none + type(field_data_t), intent(inout) :: prt + type(field_data_t), intent(in) :: prt_src + integer :: i + if (allocated (prt_src%name)) then + if (prt_src%name(1) /= "foo") call abort() + if (prt_src%name(2) /= "bar") call abort() + + if (allocated (prt%name)) deallocate (prt%name) + allocate (prt%name (size (prt_src%name)), source = prt_src%name) + ! The issue was, that prt_src was empty after sourced-allocate. + if (prt_src%name(1) /= "foo") call abort() + if (prt_src%name(2) /= "bar") call abort() + if (prt%name(1) /= "foo") call abort() + if (prt%name(2) /= "bar") call abort() + end if + end subroutine copy + +end program test_pr79344 + Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 245193) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,5 +1,12 @@ 2017-02-05 Andre Vehreschild + PR fortran/79344 + * trans-stmt.c (gfc_trans_allocate): Only deallocate the components of + the temporary, when a new object was created for the temporary. Not + when it is just an alias to an existing object. + +2017-02-05 Andre Vehreschild + PR fortran/79335 * trans-decl.c (generate_coarray_sym_init): Retrieve the symbol's attributes before using them. Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (Revision 245193) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5572,7 +5572,8 @@ expression. */ if (code->expr3) { - bool vtab_needed = false, temp_var_needed = false; + bool vtab_needed = false, temp_var_needed = false, + temp_obj_created = false; is_coarray = gfc_is_coarray (code->expr3); @@ -5645,7 +5646,7 @@ code->expr3->ts, false, true, false, false); - temp_var_needed = !VAR_P (se.expr); + temp_obj_created = temp_var_needed = !VAR_P (se.expr); } gfc_add_block_to_block (&block, &se.pre); gfc_add_block_to_block (&post, &se.post); @@ -5714,11 +5715,12 @@ } /* Deallocate any allocatable components in expressions that use a - temporary, i.e. are not of expr-type EXPR_VARIABLE or force the - use of a temporary, after the assignment of expr3 is completed. */ + temporary object, i.e. are not a simple alias of to an EXPR_VARIABLE. + E.g. temporaries of a function call need freeing of their components + here. */ if ((code->expr3->ts.type == BT_DERIVED || code->expr3->ts.type == BT_CLASS) - && (code->expr3->expr_type != EXPR_VARIABLE || temp_var_needed) + && (code->expr3->expr_type != EXPR_VARIABLE || temp_obj_created) && code->expr3->ts.u.derived->attr.alloc_comp) { tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,