From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 106336 invoked by alias); 7 Jul 2015 11:11:18 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 106313 invoked by uid 89); 7 Jul 2015 11:11:17 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=0.2 required=5.0 tests=AWL,BAYES_50,FREEMAIL_FROM,KAM_ASCII_DIVIDERS,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=no version=3.3.2 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 (AES256-GCM-SHA384 encrypted) ESMTPS; Tue, 07 Jul 2015 11:11:15 +0000 Received: from vepi2 ([84.63.202.252]) by mail.gmx.com (mrgmx103) with ESMTPSA (Nemesis) id 0LvDpe-1Z2yY60bQ2-010OhL; Tue, 07 Jul 2015 13:11:12 +0200 Date: Tue, 07 Jul 2015 11:11:00 -0000 From: Andre Vehreschild To: Paul Richard Thomas Cc: GCC-Patches-ML , GCC-Fortran-ML , Mikael Morin Subject: Re: [Patch, fortran, pr66578, v1] [F2008] Invalid free on allocate(...,source=a(:)) in block Message-ID: <20150707131111.1d2a1670@vepi2> In-Reply-To: References: <20150706145823.7e58cba2@vepi2> <8551C1A9-7974-47F1-8F9D-F4CD5C611637@gmx.de> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/I7Hj+WYigTYSTEc+VX4d+45" X-UI-Out-Filterresults: notjunk:1;V01:K0:siqqWBAMpiU=:EGNH8ZFRqWd8FF5teuX4XK FrAjVa7pg4sNVpdVYl/b0HSgh+Vmey0GEm3qTAIPKjtYbYdLkT8V/js8IfggVrY8HPkvor2K3 TFHG7BgRdmIaddem/pEqThpCEw7xA6BbLAyNQ8MBrcg29LvG0i+ezoBO+06PTaCUurfdzURN9 /9etPwe3W0i2Dc0LiemPkiH0rE9zY9+5AnegcLMbiC356rTel596hPXoV6KnBFTlr/ZEMhv3s xokjs/rT+svDB6x39U6ZIvOIeKgPJllsMPlECIWVJJ+GP3RIbyeZVZYnGXKL9FyA0+gaPzSC2 YJsL8NBN87ZXnOajP17DhBCgIRVGpSxKBERONtYhHgENpXIe6guaKa+JkgUY9BFyqB6LxPKgQ 7VFCrFIIcKBG5hZJNOM36Vbd9FuYlbXLBlltZ12028NsBMYO8njukrfKfZTQbC5JMMFtHOsBf HWvu/dU6ztqOZG+rewf5G/G0/fBpDLAh4yxiS21HYgAB5VYqUx1AqsKaQti14WVi7kpfBJPvh tkD5IQgH4G2DQ74rXeT4Tm9AFTnk1++OlC/AWjQiv+eeJklPZfcRvZ+u76M/Q7RygJVsHrmvB 3Ml/zYsC7KfNTHYwT6GLBs9/UzZnefAkVHEowFa+5Om651snFjGHclBjHc+OOlnBakEJzlwI9 wpoWe1mNmG60h8G+hGAjD65dIcw0RDkJ96W1MHaL8HpD8og== X-SW-Source: 2015-07/txt/msg00466.txt.bz2 --MP_/I7Hj+WYigTYSTEc+VX4d+45 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline Content-length: 138 Hi all, hi Paul, Paul thanks for the review. Committed as r225507. Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de --MP_/I7Hj+WYigTYSTEc+VX4d+45 Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=submit.diff Content-length: 5355 Index: gcc/fortran/trans-expr.c =================================================================== *** gcc/fortran/trans-expr.c (revision 223641) --- gcc/fortran/trans-expr.c (working copy) *************** gfc_conv_procedure_call (gfc_se * se, gf *** 5877,5882 **** --- 5877,5896 ---- fntype = TREE_TYPE (TREE_TYPE (se->expr)); se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist); + /* Allocatable scalar function results must be freed and nullified + after use. This necessitates the creation of a temporary to + hold the result to prevent duplicate calls. */ + if (!byref && sym->ts.type != BT_CHARACTER + && sym->attr.allocatable && !sym->attr.dimension) + { + tmp = gfc_create_var (TREE_TYPE (se->expr), NULL); + gfc_add_modify (&se->pre, tmp, se->expr); + se->expr = tmp; + tmp = gfc_call_free (tmp); + gfc_add_expr_to_block (&post, tmp); + gfc_add_modify (&post, se->expr, build_int_cst (TREE_TYPE (se->expr), 0)); + } + /* If we have a pointer function, but we don't want a pointer, e.g. something like x = f() Index: gcc/fortran/trans-stmt.c =================================================================== *** gcc/fortran/trans-stmt.c (revision 223641) --- gcc/fortran/trans-stmt.c (working copy) *************** gfc_trans_allocate (gfc_code * code) *** 5214,5219 **** --- 5214,5220 ---- false, false); gfc_add_block_to_block (&block, &se.pre); gfc_add_block_to_block (&post, &se.post); + /* Prevent aliasing, i.e., se.expr may be already a variable declaration. */ if (!VAR_P (se.expr)) *************** gfc_trans_allocate (gfc_code * code) *** 5223,5230 **** se.expr); /* We need a regular (non-UID) symbol here, therefore give a prefix. */ ! var = gfc_create_var (TREE_TYPE (tmp), "atmp"); gfc_add_modify_loc (input_location, &block, var, tmp); tmp = var; } else --- 5224,5243 ---- se.expr); /* We need a regular (non-UID) symbol here, therefore give a prefix. */ ! var = gfc_create_var (TREE_TYPE (tmp), "expr3"); gfc_add_modify_loc (input_location, &block, var, tmp); + + /* Deallocate any allocatable components after all the allocations + and assignments of expr3 have been completed. */ + if (code->expr3->ts.type == BT_DERIVED + && code->expr3->rank == 0 + && code->expr3->ts.u.derived->attr.alloc_comp) + { + tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived, + var, 0); + gfc_add_expr_to_block (&post, tmp); + } + tmp = var; } else Index: gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 =================================================================== *** gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (revision 0) --- gcc/testsuite/gfortran.dg/allocatable_scalar_13.f90 (working copy) *************** *** 0 **** --- 1,70 ---- + ! { dg-do run } + ! { dg-options "-fdump-tree-original" } + ! + ! Test the fix for PR66079. The original problem was with the first + ! allocate statement. The rest of this testcase fixes problems found + ! whilst working on it! + ! + ! Reported by Damian Rouson + ! + type subdata + integer, allocatable :: b + endtype + ! block + call newRealVec + ! end block + contains + subroutine newRealVec + type(subdata), allocatable :: d, e, f + character(:), allocatable :: g, h, i + character(8), allocatable :: j + allocate(d,source=subdata(1)) ! memory was lost, now OK + allocate(e,source=d) ! OK + allocate(f,source=create (99)) ! memory was lost, now OK + if (d%b .ne. 1) call abort + if (e%b .ne. 1) call abort + if (f%b .ne. 99) call abort + allocate (g, source = greeting1("good day")) + if (g .ne. "good day") call abort + allocate (h, source = greeting2("hello")) + if (h .ne. "hello") call abort + allocate (i, source = greeting3("hiya!")) + if (i .ne. "hiya!") call abort + call greeting4 (j, "Goodbye ") ! Test that dummy arguments are OK + if (j .ne. "Goodbye ") call abort + end subroutine + + function create (arg) result(res) + integer :: arg + type(subdata), allocatable :: res, res1 + allocate(res, res1, source = subdata(arg)) + end function + + function greeting1 (arg) result(res) ! memory was lost, now OK + character(*) :: arg + Character(:), allocatable :: res + allocate(res, source = arg) + end function + + function greeting2 (arg) result(res) + character(5) :: arg + Character(:), allocatable :: res + allocate(res, source = arg) + end function + + function greeting3 (arg) result(res) + character(5) :: arg + Character(5), allocatable :: res, res1 + allocate(res, res1, source = arg) ! Caused an ICE + if (res1 .ne. res) call abort + end function + + subroutine greeting4 (res, arg) + character(8), intent(in) :: arg + Character(8), allocatable, intent(out) :: res + allocate(res, source = arg) ! Caused an ICE + end subroutine + end + ! { dg-final { scan-tree-dump-times "builtin_malloc" 20 "original" } } + ! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } } + ! { dg-final { cleanup-tree-dump "original" } } --MP_/I7Hj+WYigTYSTEc+VX4d+45--