** 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 <bur...@net-b.de> 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 <bur...@net-b.de>
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 <bur...@net-b.de>
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
