From patchwork Sun Jan 6 16:52:23 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 209785 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]) by ozlabs.org (Postfix) with SMTP id 949822C0080 for ; Mon, 7 Jan 2013 03:52:44 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1358095964; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject: References:In-Reply-To:Content-Type:Mailing-List:Precedence: List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender: Delivered-To; bh=hi2l4LMOEIdj2Er4J5zVGhRl8uI=; b=QBS7DaWlvNb4/AU +dirKOYHezrfr1vKmaYCYbGDylj9osCG7Cx6DscRKVJvNnjJ9Q/sNcSI1ow2At+Z NkiP9ij9SooYmBNWjXuyiU7UGcEseFtTtC9uZo7OhlHoEA/1/9gFOqV/8/qsIaub KA31sqTeXsBVLpM4fSRkw08y3keA= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:CC:Subject:References:In-Reply-To:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=JCxtMtwhEDxTb0G0TUmqWPBf9Scq0WPChAGraufbjMmfr/+G6tZz/+hwr8Pf3T 45lWLD5+an5Bi+Z2fucpR+WaINb0aTGnmuDb13hYFsnwCbnUhYy0+q7eBWAXjCD2 BDBzUEvDNpqaWaa12IAoVKcutlTNJ0ZXyzYWwVZOmZDJg=; Received: (qmail 14965 invoked by alias); 6 Jan 2013 16:52:35 -0000 Received: (qmail 14942 invoked by uid 22791); 6 Jan 2013 16:52:32 -0000 X-SWARE-Spam-Status: No, hits=-2.9 required=5.0 tests=AWL, BAYES_00, KHOP_THREADED, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 06 Jan 2013 16:52:25 +0000 Received: from archimedes.net-b.de (port-92-195-50-179.dynamic.qsc.de [92.195.50.179]) by mx02.qsc.de (Postfix) with ESMTP id 5B3BB24703; Sun, 6 Jan 2013 17:52:23 +0100 (CET) Message-ID: <50E9ABC7.4040705@net-b.de> Date: Sun, 06 Jan 2013 17:52:23 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/17.0 Thunderbird/17.0 MIME-Version: 1.0 To: Janne Blomqvist CC: gcc patches , gfortran Subject: Re: [Patch, Fortran] PR55758 - Non-C_Bool handling with BIND(C) References: <50DCCC29.6010206@net-b.de> <50E01A7C.2090106@net-b.de> In-Reply-To: <50E01A7C.2090106@net-b.de> 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 ** ping ** Attached is a small variation, which in addition handles the case that a non-BOOL_C LOGICAL, Bind(C) dummy argument (or result variable) is used in a procedure call. In that case, the variable is now converted to a TYPE_PRECISION == 1 variable. -- The updated patch was build and regtested successfully. As written before, I believe that the patch avoids some pitfalls with C interoperability of logical variables: On one hand, it improves cross-compiler portability by rejecting non C_BOOL ones with -std=f2003/f2008/f2008ts; on the other hand, it makes wrong-code issues due to using non-0/1 integers from C much less likely. In both cases, the type-precision==1 handling for non-BIND(C) Fortran LOGICALs or for Bind(C) LOGICAL(kind=C_BOOL) remains the same; hence, no optimization issue is caused. OK for the trunk? Tobias PS: If there is consensus that this patch is a bad idea, I propose to reject non-C_BOOL LOGICALs unconditionally as dummy argument or result variable of BIND(C) procedures. Or do you have a better suggestion? On December 30, 2012, Tobias Burnus wrote: > Janne Blomqvist wrote: >> On Fri, Dec 28, 2012 at 12:31 AM, Tobias Burnus wrote: >>> a) The Fortran standard only defines LOGICAL(kind=C_Bool) as being >>> interoperable with C - no other LOGICAL type. That matches GCC: With >>> gcc >>> (the C compiler) only _Bool is a BOOLEAN_TYPE with TYPE_PRECISION == 1. >>> Hence, this patch rejects other logical kinds as dummy argument/result >>> variable in BIND(C) procedures if -std=f2003/f2008/f2008ts is specified >>> (using -pedantic, one gets a warning). >> Sorry, I don't understand, what is the -pedantic warning about if it's >> already rejected? Or do you mean std=gnu -pedantic? > > The latter. Actually, I use "gfc_notify_std(GFC_STD_GNU, ..." and just > observed the -pedantic result. (I have to admit that I never quite > understood - and still don't - what -pedantic exactly does.) > >>> b) As GNU extension, other logical kinds are accepted in BIND(C) >>> procedures; >>> however, as the main use of "LOGICAL(kind=4)" (for BIND(C) >>> procedures) is to >>> handle logical expressions which use C's int, one has to deal with all >>> integer values and not only 0 and 1. Hence, a normal integer type is >>> used >>> internally in that case. That has been done to avoid surprises of >>> users and >>> hard to trace bugs. >> Does this actually work robustly? > > I think it does in the sense that it mitigates the problems related to > LOGICAL(kind=4) and BIND(C) procedures. No, if one thinks of it as > full cure for the problem. The only way to ensure this is to turn all > of gfortran's LOGICALs into integers - and even that won't prevent > issues related to interoperability with C's _Bool as that one expects > only 0 and 1. Thus, either C<->Fortran or Fortran <-> Fortran > logical(kind=C_Bool) could still lead to problems. > >> E.g. if you have a logical but really integer under the covers, what >> happens if you equivalence it with a "normal" logical variable. > > Well, equivalencing of actual arguments / result variables is not > allowed (I think, not checked). Besides, if you have equivalenced two > variables, if you have set one, you may not access the other, e.g.: > > logical :: A > integer :: B > equivalence (A,B) > A = .true. > B = 1 > if (A) ... > > is invalid as "A" is not defined, even if A = .true. and B = 1 have > exactly the same storage size and bit patterns and, hence, in practice > "A" would be a well defined .true. > >> Or pass it as an argument to a procedure expecting a normal logical etc. > > If the value is only 1 or 0, there shouldn't be any problems. Only if > one uses in turn ".not. dummy" there might be one. > > The idea of the patch was only to mitigate the problems - a full cure > is not possible (cf. above). I think the most likely problematic code is > if (.not. c_function()) > which is fixed by the patch. And the hope is that fold-converting to a > type-precision=1, Boolean-type logical fixes most of the remaining > issues. > > I think the current solution which only affects non-C_BOOL-kind actual > arguments and result variables of BIND(C) procedures is a good > compromise. > > * * * > > But if others do not like this approach, one could turn the > gfc_notify_std into a gfc_error are completely reject logicals with > kinds /= C_Bool for dummy arguments/result variables in BIND(C) > procedures. Would you prefer that approach? > > (Doing so will break user code (e.g. Open MPI) and make users unhappy > but it will be a tad safer as the current patch.) > > Tobias > 2013-01-06 Tobias Burnus PR fortran/55758 * resolve.c (resolve_symbol): Reject non-C_Bool logicals in BIND(C) procedures with -std=f*. * trans-types.c (gfc_sym_type): Use a non-BOOLEAN_TYPE integer for non-C_Bool logicals in BIND(C) procedures. * trans-expr.c (gfc_conv_unary_op): Add fold convert for INTRINSIC_NOT. (gfc_conv_procedure_call): Convert type-precision != 1 logicals to type-precision == 1. 2013-01-06 Tobias Burnus PR fortran/55758 * gfortran.dg/bind_c_bool_1.f90: New. * gfortran.dg/bind_c_bool_2.f90: New. * gfortran.dg/bind_c_bool_2_c.c: New. * gfortran.dg/bind_c_bool_3.f90: New. * gfortran.dg/do_5.f90: Add dg-warning. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 54ac3c6..0403396 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13658,6 +13662,32 @@ resolve_symbol (gfc_symbol *sym) return; } + if (sym->ts.type == BT_LOGICAL + && ((sym->attr.function && sym->attr.is_bind_c && sym->result == sym) + || ((sym->attr.dummy || sym->attr.result) && sym->ns->proc_name + && sym->ns->proc_name->attr.is_bind_c))) + { + int i; + for (i = 0; gfc_logical_kinds[i].kind; i++) + if (gfc_logical_kinds[i].kind == sym->ts.kind) + break; + if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy + && gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument '%s' at %L " + "with non-C_Bool kind in BIND(C) procedure '%s'", + sym->name, &sym->declared_at, + sym->ns->proc_name->name) == FAILURE) + return; + else if (!gfc_logical_kinds[i].c_bool + && gfc_notify_std (GFC_STD_GNU, "LOGICAL result variable '%s' at" + " %L with non-C_Bool kind in BIND(C) " + "procedure '%s'", sym->name, + &sym->declared_at, + sym->attr.function ? sym->name + : sym->ns->proc_name->name) + == FAILURE) + return; + } + switch (sym->attr.flavor) { case FL_VARIABLE: diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 01d3595..59a0ab4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1850,7 +1850,8 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr) We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)). All other unary operators have an equivalent GIMPLE unary operator. */ if (code == TRUTH_NOT_EXPR) - se->expr = fold_build2_loc (input_location, EQ_EXPR, type, operand.expr, + se->expr = fold_build2_loc (input_location, EQ_EXPR, type, + fold_convert (type, operand.expr), build_int_cst (type, 0)); else se->expr = fold_build1_loc (input_location, code, type, operand.expr); @@ -4208,6 +4209,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } else gfc_conv_expr (&parmse, e); + + /* Special case: non-kind=C_BOOL LOGICALs of BIND(C) are + integer types and have to be converted to Booleans. */ + if (e->ts.type == BT_LOGICAL + && TYPE_PRECISION (TREE_TYPE (parmse.expr)) != 1) + parmse.expr + = fold_convert (gfc_get_logical_type (e->ts.kind), + parmse.expr); } else if (arg->name && arg->name[0] == '%') /* Argument list functions %VAL, %LOC and %REF are signalled @@ -4260,6 +4269,28 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, base_object = build_fold_indirect_ref_loc (input_location, parmse.expr); + /* Special case: non-kind=C_BOOL LOGICALs of BIND(C) are + integer types and have to be converted to Booleans. */ + if (e->ts.type == BT_LOGICAL + && TYPE_PRECISION (TREE_TYPE (TREE_TYPE (parmse.expr))) + != 1) + { + tmp = build_fold_indirect_ref_loc (input_location, + parmse.expr); + parmse.expr + = gfc_create_var (gfc_get_logical_type (e->ts.kind), + NULL); + gfc_add_modify_loc (input_location, &se->pre, parmse.expr, + fold_convert (gfc_get_logical_type (e->ts.kind), + tmp)); + if (e->expr_type == EXPR_VARIABLE + && (!fsym || fsym->attr.intent != INTENT_IN + || fsym->attr.pointer)) + gfc_add_modify_loc (input_location, &se->post, tmp, + fold_convert (TREE_TYPE (tmp), parmse.expr)); + parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr); + } + /* A class array element needs converting back to be a class object, if the formal argument is a class object. */ if (fsym && fsym->ts.type == BT_CLASS diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 8394bf9..73ed5aa 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -2128,6 +2128,25 @@ gfc_sym_type (gfc_symbol * sym) && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c))) type = gfc_character1_type_node; + else if (sym->ts.type == BT_LOGICAL + && ((sym->attr.function && sym->attr.is_bind_c) + || ((sym->attr.dummy || sym->attr.result) && sym->ns->proc_name + && sym->ns->proc_name->attr.is_bind_c))) + { + /* For LOGICAL dummy arguments or result value of a C binding procedure, + which do not match _Bool (C_Bool kind), a normal integer variable + is used instead of a BOOLEAN_TYPE with a TYPE_PRECISION of 1. The + reason is that on the C side, a normal integer such as "int" is used, + implying that any integer value could be used - not only 0 and 1. */ + int i; + for (i = 0; gfc_logical_kinds[i].kind; i++) + if (gfc_logical_kinds[i].kind == sym->ts.kind) + break; + if (!gfc_logical_kinds[i].c_bool) + type = gfc_get_int_type (sym->ts.kind); + else + type = gfc_typenode_for_spec (&sym->ts); + } else type = gfc_typenode_for_spec (&sym->ts); diff --git a/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 b/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 new file mode 100644 index 0000000..467bdc1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_bool_1.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } +! +! PR fortran/55758 +! + +function sub2() bind(C) ! { dg-error "GNU Extension: LOGICAL result variable 'sub2' at .1. with non-C_Bool kind in BIND.C. procedure 'sub2'" } + logical(kind=8) :: sub2 + logical(kind=4) :: local ! OK +end function sub2 + +function sub4() bind(C) result(res) ! { dg-error "GNU Extension: LOGICAL result variable 'res' at .1. with non-C_Bool kind in BIND.C. procedure 'sub4'" } + logical(kind=2) :: res + logical(kind=4) :: local ! OK +end function sub4 + + +subroutine sub(x) bind(C) ! { dg-error "GNU Extension: LOGICAL dummy argument 'x' at .1. with non-C_Bool kind in BIND.C. procedure 'sub'" } + logical(kind=4) :: x +end subroutine sub + +subroutine sub3(y) bind(C) + use iso_c_binding, only : c_bool + logical(kind=c_bool) :: y ! OK +end subroutine sub3 diff --git a/gcc/testsuite/gfortran.dg/bind_c_bool_2.f90 b/gcc/testsuite/gfortran.dg/bind_c_bool_2.f90 new file mode 100644 index 0000000..1feb28d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_bool_2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! { dg-options "" } +! { dg-additional-sources bind_c_bool_2_c.c } +! +! PR fortran/55758 +! +! Ensure that logical(c_int) in a BIND(C) function is properly handled, +! i.e. ".not.-1" is not "-2" but 0 as a C programmer would expect. +! + +program main + use iso_c_binding, only : c_int, c_bool + implicit none + logical(4) :: result + + interface + function C_true() bind(C, name="C_true") + import :: c_int + logical(c_int) :: C_true ! { dg-warning "C kind type parameter is for type INTEGER but type at .1. is LOGICAL" } + end function C_true + end interface + + if (c_int == c_bool) stop + + result = C_true() + if (result .neqv. .true.) call abort () + if (transfer(result, 0) /= 1) call abort() + + result = .not.C_true() + if (transfer(result, 0) /= 0) call abort() + if (result .neqv. .false.) call abort () +end program main diff --git a/gcc/testsuite/gfortran.dg/bind_c_bool_2_c.c b/gcc/testsuite/gfortran.dg/bind_c_bool_2_c.c new file mode 100644 index 0000000..3673bdc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_bool_2_c.c @@ -0,0 +1,7 @@ +/* To be used by bind_c_bool_2.f90. PR fortran/55758 */ + +int +C_true (void) +{ + return -1; +} diff --git a/gcc/testsuite/gfortran.dg/bind_c_bool_3.f90 b/gcc/testsuite/gfortran.dg/bind_c_bool_3.f90 new file mode 100644 index 0000000..a73bf6e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_bool_3.f90 @@ -0,0 +1,59 @@ +! { dg-do run } +! { dg-options "" } +! +! PR fortran/55758 +! +! Ensure that a BIND(C) non-C_BOOL LOGICAL with TYPE_PRECISION != 1 is +! correctly converted into a Fortran LOGICAL with TYPE_PRECSION == 1 in +! Procedure calls. +! + +subroutine bar3(x) + logical(kind=4) :: x + logical(kind=4) :: y + y = .not.x + !print *, y, transfer(x,0) + if (y .or. .not. x) call abort() + x = .true. +end subroutine bar3 + +module m +contains +subroutine foo(x) bind(C) + integer :: i + logical(kind=4) :: x + i = -1 + x = transfer(i,.true._4) + call bar(x) + + x = transfer(i,.true._4) + call bar2(x) + if (transfer (x, 1) /= 1) call abort() + + x = transfer(i,.true._4) + call bar3(x) + if (transfer (x, 1) /= 1) call abort() +end subroutine foo + +subroutine bar(x) + logical(kind=4), value :: x + logical(kind=4) :: y + y = .not.x + !print *, y, transfer(x,0) + if (y .or. .not. x) call abort() + x = .true. +end subroutine bar + +subroutine bar2(x) + logical(kind=4) :: x + logical(kind=4) :: y + y = .not.x + if (y .or. .not. x) call abort() + !print *, y, transfer(x,0) +end subroutine bar2 +end + +use m +logical(kind=4) :: x +call foo(x) +end diff --git a/gcc/testsuite/gfortran.dg/do_5.f90 b/gcc/testsuite/gfortran.dg/do_5.f90 index 08cd8e6..9272d87 100644 --- a/gcc/testsuite/gfortran.dg/do_5.f90 +++ b/gcc/testsuite/gfortran.dg/do_5.f90 @@ -15,7 +15,7 @@ L = .FALSE. END FUNCTION - LOGICAL(8) FUNCTION L2() BIND(C) + LOGICAL(8) FUNCTION L2() BIND(C) ! { dg-error "GNU Extension: LOGICAL result variable 'l2' at .1. with non-C_Bool kind in BIND.C. procedure 'l2'" } L2 = .FALSE._8 END FUNCTION