From patchwork Wed Oct 30 23:29:05 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1187105 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-512127-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="nF+5ZmrE"; dkim-atps=neutral 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 473Pmz2V7cz9sPh for ; Thu, 31 Oct 2019 10:29:39 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=gJAfDpAO5EXO5yu3OUqRgvu5PZpePW7jeqI0P4FJzD6WUHeuso rtzZDelkP5tLbmYs5Wgqgzd+BaTk0F45LmyH1/yczC/iAAd1uYl1k7lbd6O3cjRK EU/2WM06fnYHQcdXBQlk8a3NcrrXBjUdvSJaS3Zub90lNAAoB3Uq6+ssI= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=L7sECXwBc3P24Fv9TQus0damSxE=; b=nF+5ZmrEAVjavco8bajr Z3kvFiS/LEEc/Usbi6Co1ubqSA+ZqoYvD7N6Wy8TpFIxcUfepGMbqiRrsssMlHAr B9atQP63kEzNYxVES7z12XHcKRAU4s5UdbIX+ggx4ZVgUarUjhgFvnff1T9NAAwM 1w/gz8Bkaf//OapK0AfvBi8= Received: (qmail 107076 invoked by alias); 30 Oct 2019 23:29:23 -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 106997 invoked by uid 89); 30 Oct 2019 23:29:22 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-17.9 required=5.0 tests=AWL, BAYES_00, GARBLED_SUBJECT, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, SPF_PASS autolearn=ham version=3.3.1 spammy=Transfer, sk:bind_c_, dim, sk:bindc X-HELO: esa2.mentor.iphmx.com Received: from esa2.mentor.iphmx.com (HELO esa2.mentor.iphmx.com) (68.232.141.98) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 30 Oct 2019 23:29:20 +0000 IronPort-SDR: i1NCZR9xp4LlQXwdN8wlN3CtMQeEQlPA8a37Y2OjBB+P3oIWODzAaxQtRAz/ntzNKzkfL+Q/JR guUXbSMV+BlrY+wH5xR438tD+PxllDLi/RG0I1yZNqd26MVJbvNpyM4/ChBw2bwfDtWkFhu+in f6JdhRCZRCDrrwLXlZhSnrkEQCYx3aL3MrsJku+iEGkh3xb0JAcjVH6Pb7XAdA3Y9iq2+x2x8O ywpVooPQwpXQ14SRJXX0/tQaXnPWQUIQWF2iHjsbhO9bwYBh9coKgbPVFTV/uw6vAi+wIG6A+6 E8A= Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 30 Oct 2019 15:29:18 -0800 IronPort-SDR: X2W2iMPp7hBMY5YXA4XhPLR0uFBChFtenNDu09laZeY/QkzwHDM0NM8pT7XeLBhfbj/v5mwiER WQkoT/cHWghFV7CJXdQ6LaQNiPXjVa7Tp6pJ7WE7yQc3WycpUiZ6qM83Ui2OnR2L02yhus5mhJ jDktMXx0NX/5UpGa42OXz7s6m8MOfmS+UJx8W8SNPRU2JV5rn81xDxtgMfg3+RLQBq5GFUI+0e 3LEYSFwTY64v7fxBB1e0/TQseE4SmU37q9BUrt025Qx8kGkuyGfXkIKQmppqeeqbdmylO6Cwvi 9FA= To: gcc-patches , fortran , Paul Richard Thomas From: Tobias Burnus Subject: =?utf-8?b?W1BhdGNoLEZvcnRyYW5dIFBSOTIyODQg4oCTIGdmY19kZXNjX3Rv?= =?utf-8?q?=5Fcfi=5Fdesc_fixes?= Message-ID: Date: Thu, 31 Oct 2019 00:29:05 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.1.2 MIME-Version: 1.0 X-IsSubscribed: yes Playing with the PR92284 test case revealed two issues related to gfc_desc_to_cfi_desc: * Access of uninitialized memory – copying the array bounds (in libgfortran) does not make sense for unallocted allocatables and nullified pointers. Hence, check for ".data == NULL". * There is a memory leak. I misunderstood the dump when fixing PR91863 (rev.277502). https://gcc.gnu.org/ml/gcc-patches/2019-10/msg01651.html Regarding the latter: If one passed gfc_desc_to_cfi_desc a pointer var, pointing to NULL, as CFI (Bind(C) array descriptor) argument, libgfortran allocates the memory for the descriptor – which at some point has to be freed. Contrary to the original version, one can free that memory unconditionally. (Not only because "free" handles NULL pointers but – unless "malloc" failed – we know that ptr has been malloced.) I also tried to make the comments a bit clearer. Build and regtested. OK for trunk and GCC 9 (the latter is also affected)? Tobias PR: Related pending patch: https://gcc.gnu.org/ml/gcc-patches/2019-10/msg02148.html Also missing: At the end of a bind(C) procedure written in Fortran, allocatable/pointers array arguments need get updated: the "data" and the bounds part of the array descriptor might have changed while running the procedure body. Cf. this PR and PR 92189 gcc/fortran/ PR fortran/92284. * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Free CFI descriptor at the end; partial revised revert of Rev. 277502. libgfortran/ PR fortran/92284. * runtime/ISO_Fortran_binding.c (gfc_desc_to_cfi_desc): gcc/testsuite/ PR fortran/92284. * gfortran.dg/bind-c-intent-out.f90: Update expected dump; extend comment. * gfortran.dg/bind_c_array_params_3.f90: New. * gfortran.dg/bind_c_array_params_3_aux.c: New. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7eba1bbd082..f800faaa4e5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5303,13 +5303,13 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) /* Now pass the gfc_descriptor by reference. */ parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr); - /* Variables to point to the gfc and CFI descriptors. */ + /* Variables to point to the gfc and CFI descriptors; cfi = NULL implies + that the CFI descriptor is allocated by the gfor_fndecl_gfc_to_cfi call. */ gfc_desc_ptr = parmse->expr; cfi_desc_ptr = gfc_create_var (pvoid_type_node, "cfi"); - gfc_add_modify (&parmse->pre, cfi_desc_ptr, - build_int_cst (pvoid_type_node, 0)); + gfc_add_modify (&parmse->pre, cfi_desc_ptr, null_pointer_node); - /* Allocate the CFI descriptor and fill the fields. */ + /* Allocate the CFI descriptor itself and fill the fields. */ tmp = gfc_build_addr_expr (NULL_TREE, cfi_desc_ptr); tmp = build_call_expr_loc (input_location, gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); @@ -5324,6 +5324,10 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) /* The CFI descriptor is passed to the bind_C procedure. */ parmse->expr = cfi_desc_ptr; + /* Free the CFI descriptor. */ + tmp = gfc_call_free (cfi_desc_ptr); + gfc_prepend_expr_to_block (&parmse->post, tmp); + /* Transfer values back to gfc descriptor. */ tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr); tmp = build_call_expr_loc (input_location, diff --git a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 index 493e546d45d..39822c0753a 100644 --- a/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 +++ b/gcc/testsuite/gfortran.dg/bind-c-intent-out.f90 @@ -35,7 +35,8 @@ end program p ! the intent(out) implies freeing in the callee (!), hence the "free" ! It is the only 'free' as 'a' is part of the main program and, hence, implicitly has the SAVE attribute. ! The 'cfi = 0' appears before the call due to the deallocate and when preparing the C descriptor +! As cfi (i.e. the descriptor itself) is allocated in libgomp, it has to be freed after the call. -! { dg-final { scan-tree-dump-times "__builtin_free" 1 "original" } } -! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_free \\(cfi\\.\[0-9\]+\\);" 2 "original" } } ! { dg-final { scan-tree-dump-times "cfi\\.\[0-9\]+ = 0B;" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90 b/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90 new file mode 100644 index 00000000000..d5bad7d03f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_3.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! { dg-additional-sources bind_c_array_params_3_aux.c } +! +! PR fortran/92284 +! +! Contributed by José Rui Faustino de Sousa +! +program arr_p + use, intrinsic :: iso_c_binding, only: c_int + implicit none (type, external) + + integer(kind=c_int), pointer :: arr(:) + integer :: i + + nullify(arr) + call arr_set(arr) + + if (.not.associated(arr)) stop 1 + if (lbound(arr,dim=1) /= 1) stop 2 + if (ubound(arr,dim=1) /= 9) stop 3 + if (any (arr /= [(i, i=0,8)])) stop 4 + deallocate(arr) + +contains + + subroutine arr_set(this) !bind(c) + integer(kind=c_int), pointer, intent(out) :: this(:) + + interface + subroutine arr_set_c(this) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + implicit none + integer(kind=c_int), pointer, intent(out) :: this(:) + end subroutine arr_set_c + end interface + + call arr_set_c(this) + end subroutine arr_set +end program arr_p diff --git a/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c b/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c new file mode 100644 index 00000000000..6e13aa3b2ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_array_params_3_aux.c @@ -0,0 +1,27 @@ +/* Used by bind_c_array_params_3.f90. */ +/* PR fortran/92284. */ + +#include +#include +#include + +#include "ISO_Fortran_binding.h" + +void arr_set_c(CFI_cdesc_t*); + +void arr_set_c(CFI_cdesc_t *arr){ + int i, stat, *auxp = NULL; + CFI_index_t lb[] = {1}; + CFI_index_t ub[] = {9}; + + assert(arr); + assert(arr->rank==1); + assert(!arr->base_addr); + stat = CFI_allocate(arr, lb, ub, sizeof(int)); + assert(stat==CFI_SUCCESS); + auxp = (int*)arr->base_addr; + assert(auxp); + for(i=0; itype = (CFI_type_t)(d->type + ((CFI_type_t)d->elem_len << CFI_type_kind_shift)); - /* Full pointer or allocatable arrays retain their lower_bounds. */ - for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++) - { - if (d->attribute != CFI_attribute_other) - d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n); - else - d->dim[n].lower_bound = 0; - - /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1. */ - if ((n == GFC_DESCRIPTOR_RANK (s) - 1) - && GFC_DESCRIPTOR_LBOUND(s, n) == 1 - && GFC_DESCRIPTOR_UBOUND(s, n) == 0) - d->dim[n].extent = -1; - else - d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n) - - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1; - d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span); - } + if (d->base_addr) + /* Full pointer or allocatable arrays retain their lower_bounds. */ + for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++) + { + if (d->attribute != CFI_attribute_other) + d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n); + else + d->dim[n].lower_bound = 0; + + /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1. */ + if (n == GFC_DESCRIPTOR_RANK (s) - 1 + && GFC_DESCRIPTOR_LBOUND(s, n) == 1 + && GFC_DESCRIPTOR_UBOUND(s, n) == 0) + d->dim[n].extent = -1; + else + d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n) + - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1; + d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span); + } if (*d_ptr == NULL) *d_ptr = d;