From patchwork Mon Oct 21 17:28:36 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1180748 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-511446-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="vOzxkJ2V"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="UuebT6Ke"; 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 46xkC26tSSz9sNx for ; Tue, 22 Oct 2019 04:29:01 +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 :mime-version:references:in-reply-to:from:date:message-id :subject:to:cc:content-type; q=dns; s=default; b=OUO8AjtzhAXhfsZ cyPojj34stHvEg/qUBvzSP0clTeWWe3ltUaUKZ/YMkIVS5bm/9NID1bnmojHx4fF AIN8e/+uATWjLp5Q/Tj5XSZVxChyfDSBQeTchIHuvb49Fd2U6EEjW+132v8beMQd aeurN3LcfFiD874ZvGEeI/hJ0cZU= 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 :mime-version:references:in-reply-to:from:date:message-id :subject:to:cc:content-type; s=default; bh=Fura9Lr7g9itLsZhvWm1q RY1RQw=; b=vOzxkJ2V0PxMZOT8c7o/cwO3lj1URFUZj4YXop8cFu9lTfqsfT8o5 SpU5VSadhNyiugF1a03DPZkWl1ujbfV3PWQk7MMwAf6jsdsEK2kM8I9A5qx+FO39 SWQquZBiWf4JJ8qSV5moQixiwl40FnYZLxVEyUfGD6Lr4+V5kSP3+w= Received: (qmail 82802 invoked by alias); 21 Oct 2019 17:28:53 -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 82542 invoked by uid 89); 21 Oct 2019 17:28:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: =?iso-8859-1?q?No=2C_score=3D-4=2E0_required=3D5=2E0?= =?iso-8859-1?q?_tests=3DAWL=2CBAYES_00=2CFREEMAIL_FROM=2CGIT_PATCH?= =?iso-8859-1?q?_2=2CKAM_ASCII_DIVIDERS=2CRCVD_IN_DNSWL_NONE=2CSPF_?= =?iso-8859-1?q?PASS_autolearn=3Dham_version=3D3=2E3=2E1_spammy=3Dj?= =?iso-8859-1?q?os=C3=A9=2C_jos=2C_solves=2C_STOP?= X-HELO: mail-lf1-f52.google.com Received: from mail-lf1-f52.google.com (HELO mail-lf1-f52.google.com) (209.85.167.52) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 21 Oct 2019 17:28:51 +0000 Received: by mail-lf1-f52.google.com with SMTP id g21so9674783lfh.4; Mon, 21 Oct 2019 10:28:50 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to :cc; bh=3GjIlWKf26NZjG4K4aqIbhx0X1ir26brlACmmlpvEzU=; b=UuebT6KeWtLjDNxG6PWK/6sWh+FmgiFVjwMun8/Jvv5eF64BRFzsoWaW4ZeHCOBOpX gXRX8khC6eOxNX5NKE7Mzx/MdKCrkT9nRG1LnrpBRm6UFLghQXfNkoAw3ZWBHmJZpFkd tjA0bSLrz8NGmOkNgBwv0YkDGn1WNrcGSvgIBrICSv3aTNPqCsimg7hvByGeE1ef2ztU VpYyFOCrTotBv9obWZeWLNOOduBt4F9YIcAdwsq+kp+YkF6EXlHQkAeX0iXuwln87LR/ MOivCPOCEhlj2uir+WOAUvJhQS7s9gFfufgpy40eqlZF8KjoD3qmIlKa8XqO8mB1ucvz eGBg== MIME-Version: 1.0 References: In-Reply-To: From: Paul Richard Thomas Date: Mon, 21 Oct 2019 18:28:36 +0100 Message-ID: Subject: [Patch, fortran] PR91926 - assumed rank optional To: "fortran@gcc.gnu.org" , gcc-patches Cc: Gilles Gouaillardet Please find attached a patch to keep 9-branch up to speed with trunk as far as the ISO_Fortran_binding feature is concerned. It bootstraps and regtests on 9-branch and incorporates the correction for PR92027, which caused problems for trunk on certain platforms. OK to commit? Paul 2019-10-21 Paul Thomas Backport from trunk PR fortran/91926 * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Correct the assignment of the attribute field to account correctly for an assumed shape dummy. Assign separately to the gfc and cfi descriptors since the atribute can be different. Add branch to correctly handle missing optional dummies. 2019-10-21 Paul Thomas Backport from trunk PR fortran/91926 * gfortran.dg/ISO_Fortran_binding_13.f90 : New test. * gfortran.dg/ISO_Fortran_binding_13.c : Additional source. * gfortran.dg/ISO_Fortran_binding_14.f90 : New test. Index: gcc/fortran/trans-expr.c =================================================================== *** gcc/fortran/trans-expr.c (revision 276015) --- gcc/fortran/trans-expr.c (working copy) *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 4989,4995 **** --- 5006,5014 ---- tree gfc_desc_ptr; tree type; tree cond; + tree desc_attr; int attribute; + int cfi_attribute; symbol_attribute attr = gfc_expr_attr (e); stmtblock_t block; *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 4998,5009 **** attribute = 2; if (!e->rank || gfc_get_full_arrayspec_from_expr (e)) { ! if (fsym->attr.pointer) attribute = 0; ! else if (fsym->attr.allocatable) attribute = 1; } if (e->rank != 0) { parmse->force_no_tmp = 1; --- 5017,5036 ---- attribute = 2; if (!e->rank || gfc_get_full_arrayspec_from_expr (e)) { ! if (attr.pointer) attribute = 0; ! else if (attr.allocatable) attribute = 1; } + /* If the formal argument is assumed shape and neither a pointer nor + allocatable, it is unconditionally CFI_attribute_other. */ + if (fsym->as->type == AS_ASSUMED_SHAPE + && !fsym->attr.pointer && !fsym->attr.allocatable) + cfi_attribute = 2; + else + cfi_attribute = attribute; + if (e->rank != 0) { parmse->force_no_tmp = 1; *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 5070,5080 **** parmse->expr, attr); } ! /* Set the CFI attribute field. */ ! tmp = gfc_conv_descriptor_attribute (parmse->expr); tmp = fold_build2_loc (input_location, MODIFY_EXPR, ! void_type_node, tmp, ! build_int_cst (TREE_TYPE (tmp), attribute)); gfc_add_expr_to_block (&parmse->pre, tmp); /* Now pass the gfc_descriptor by reference. */ --- 5097,5108 ---- parmse->expr, attr); } ! /* Set the CFI attribute field through a temporary value for the ! gfc attribute. */ ! desc_attr = gfc_conv_descriptor_attribute (parmse->expr); tmp = fold_build2_loc (input_location, MODIFY_EXPR, ! void_type_node, desc_attr, ! build_int_cst (TREE_TYPE (desc_attr), cfi_attribute)); gfc_add_expr_to_block (&parmse->pre, tmp); /* Now pass the gfc_descriptor by reference. */ *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 5092,5097 **** --- 5120,5131 ---- gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr); gfc_add_expr_to_block (&parmse->pre, tmp); + /* Now set the gfc descriptor attribute. */ + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + void_type_node, desc_attr, + build_int_cst (TREE_TYPE (desc_attr), attribute)); + gfc_add_expr_to_block (&parmse->pre, tmp); + /* The CFI descriptor is passed to the bind_C procedure. */ parmse->expr = cfi_desc_ptr; *************** gfc_conv_gfc_desc_to_cfi_desc (gfc_se *p *** 5112,5117 **** --- 5146,5170 ---- tmp = build_call_expr_loc (input_location, gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp); gfc_prepend_expr_to_block (&parmse->post, tmp); + + /* Deal with an optional dummy being passed to an optional formal arg + by finishing the pre and post blocks and making their execution + conditional on the dummy being present. */ + if (fsym->attr.optional && e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.optional) + { + cond = gfc_conv_expr_present (e->symtree->n.sym); + tmp = fold_build2 (MODIFY_EXPR, void_type_node, + cfi_desc_ptr, + build_int_cst (pvoid_type_node, 0)); + tmp = build3_v (COND_EXPR, cond, + gfc_finish_block (&parmse->pre), tmp); + gfc_add_expr_to_block (&parmse->pre, tmp); + tmp = build3_v (COND_EXPR, cond, + gfc_finish_block (&parmse->post), + build_empty_stmt (input_location)); + gfc_add_expr_to_block (&parmse->post, tmp); + } } Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c (nonexistent) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.c (working copy) *************** *** 0 **** --- 1,12 ---- + /* Test the fix for PR91926. */ + + /* Contributed by José Rui Faustino de Sousa */ + + #include + + int ifb_echo(void*); + + int ifb_echo(void *this) + { + return this == NULL ? 1 : 2; + } Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_13.f90 (working copy) *************** *** 0 **** --- 1,39 ---- + ! { dg-do run { target c99_runtime } } + ! { dg-additional-sources ISO_Fortran_binding_13.c } + ! + ! Test the fix for PR91926. The additional source is the main program. + ! + ! Contributed by José Rui Faustino de Sousa + ! + program ifb_p + + implicit none + + integer :: i = 42 + + interface + integer function ifb_echo_aux(this) bind(c, name="ifb_echo") + implicit none + type(*), dimension(..), & ! removing assumed rank solves segmentation fault + optional, intent(in) :: this + end function ifb_echo_aux + end interface + + if (ifb_echo_aux() .ne. 1) STOP 1 ! worked + if (ifb_echo() .ne. 1) stop 2 ! segmentation fault + if (ifb_echo_aux(i) .ne. 2) stop 3 ! worked + if (ifb_echo(i) .ne. 2) stop 4 ! worked + + stop + + contains + + integer function ifb_echo(this) + type(*), dimension(..), & + optional, intent(in) :: this + + ifb_echo = ifb_echo_aux(this) + return + end function ifb_echo + + end program ifb_p Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 =================================================================== *** gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_14.f90 (working copy) *************** *** 0 **** --- 1,41 ---- + ! { dg-do run } + ! + ! Correct an error in the eveluation of the CFI descriptor attribute for + ! the case where the bind_C formal argument is not an assumed shape array + ! and not allocatable or pointer. + ! + ! Contributed by Gilles Gouaillardet + ! + MODULE FOO + INTERFACE + SUBROUTINE dummy(buf) BIND(C, name="sync") + type(*), dimension(..) :: buf + END SUBROUTINE + END INTERFACE + END MODULE + + PROGRAM main + USE FOO + IMPLICIT NONE + integer(8) :: before, after + + INTEGER, parameter :: n = 1 + + INTEGER, ALLOCATABLE :: buf(:) + INTEGER :: buf2(n) + INTEGER :: i + + ALLOCATE(buf(n)) + before = LOC(buf(1)) + CALL dummy (buf) + after = LOC(buf(1)) + + if (before .NE. after) stop 1 + + before = LOC(buf2(1)) + CALL dummy (buf) + after = LOC(buf2(1)) + + if (before .NE. after) stop 2 + + END PROGRAM