From patchwork Thu Dec 27 22:31:05 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Fortran] PR55758 - Non-C_Bool handling with BIND(C) Date: Thu, 27 Dec 2012 12:31:05 -0000 From: Tobias Burnus X-Patchwork-Id: 208359 Message-Id: <50DCCC29.6010206@net-b.de> To: gcc patches , gfortran Dear all, See also the discussion in the thread starting at http://gcc.gnu.org/ml/fortran/2012-12/msg00135.html 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). 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. Note: logical(c_bool) and all logicals which are not dummy or result variables of a bind(C) procedure remain BOOLEAN_TYPEs with TYPE_PRECISION == 1 bit. For those a .true. with internal value "-1" will lead the surprising result .not.(-1) => (-2) => .true., i.e. .true. == .not. .true. But that's simply an invaliduse of those logicals and not a bug in the compiler. (-> won't fix). Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2012-12-27 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. 2012-12-27 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/do_5.f90: Add dg-warning. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 873400a..5963acd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13640,6 +13636,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 452f2bc..bbfb162 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); 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/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