This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[PATCH,fortran]: [Fwd: fix part of PR 32600] - c_funloc
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 21 Jul 2007 22:08:32 +0200
- Subject: [PATCH,fortran]: [Fwd: fix part of PR 32600] - c_funloc
This patch - by Chris - fixes the another part of PR 32600 - this time
for c_funloc.
Still missing are c_f_pointer (for the scalars) and c_associated (and
c_f_funpointer once procedure pointers are supported).
In a nutshell does this patch:
* Use a function pointer instead of "void *"
* Do the assignment directly and not via a library function.
Old dump (excerpt):
void * t;
t = c_funloc (sub1);
t = c_funloc (sub2);
(Does anyone understand why this is not prefixed by __iso_c_binding_ ?
"nm libgfortran.a" shows that c_associated_* and c_f_pointer exist only
in properly prefixed form?)
New dump:
void (*<T3a>) (void) t;
t = sub1;
t = (void (*<T3a>) (void)) sub2;
Build & regression tested on x86 Linux by Chris.
Build & regression tested on x86-64 Linux by me.
As I think the patch is OK (except for the leftover of another patch in
libgfortran/gfortran.map; there only the __iso_c_binding_c_funloc should
be removed), I plan to commit it in Monday unless there were any
objections until then.
Tobias
Changelog (spaces probably messed up by mail client):
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
Tobias Burnus <burnus@net-b.de>
PR fortran/32600
* trans-expr.c (gfc_conv_function_call): Handle c_funloc.
* trans-types.c: Add pfunc_type_node.
(gfc_init_types,gfc_typenode_for_spec): Use it.
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32600
* intrinsics/iso_c_binding.c (c_funloc): Remove.
* intrinsics/iso_c_binding.h: Remove c_funloc.
* gfortran.map: Ditto.
2007-07-21 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32600
* gfortran.dg/c_funloc_tests_5.f03: New.
* gfortran.dg/c_funloc_tests_5.f04: New.
* gfortran.dg/c_funloc_tests_4_driver.c: New.
-------- Original message --------
Subject: Re: c_funloc (was: [PATCH,fortran]: fix part of PR 32600)
Date: Fri, 20 Jul 2007 10:14:25 -0600 (MDT)
From: Christopher D. Rickett <crickett@lanl.gov>
To: Tobias Burnus <burnus@net-b.de>
hi Tobias,
i got a little time to look at this sooner than i expected. your code for
trans-types.c was very useful; it seems to correctly type the c_funptr as
a function ptr now, rather than what i'd done with a simple void *.
i updated the places in trans-types.c where i set the type of c_funptr to
use the funtion ptr decl you created. also, i added code to trans-expr.c
that seems to work for inlining c_funloc (but certainly could be tested
more thoroughly). i also modified the arg checking for c_funloc to ensure
it's parameter is bind(c) (which requires it to be C interoperable).
i've bootstrapped and regtested on x86 linux with no new failures. i
haven't had time to test in on x86_64. it would be appreciated if you
could give it a try and see if it works as you'd expect. if so, you're
more than welcome to submit it as a patch to the list; i probably won't
have time until the first part of next week. i think you should
definitely be included in the patch when it's submitted.
i apologize if the patch doesn't apply cleanly; my copy of trunk has 5 or
so pending patches right now, so it's hard to come up with perfect,
reduced-size patches. ;-)
thanks again for your help. i hope the patch works for you. :-)
Chris
Index: gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c
===================================================================
--- gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c (revision 0)
+++ gcc/testsuite/gfortran.dg/c_funloc_tests_4_driver.c (revision 0)
@@ -0,0 +1,39 @@
+#include <stdio.h>
+
+void sub0(void);
+void c_sub0(void (*sub)(void));
+void c_sub1(int (*func)(int));
+
+extern void abort(void);
+
+int main(int argc, char **argv)
+{
+ printf("hello from C main\n");
+
+ sub0();
+ return 0;
+}
+
+void c_sub0(void (*sub)(void))
+{
+ printf("hello from c_sub0\n");
+ sub();
+
+ return;
+}
+
+void c_sub1(int (*func)(int))
+{
+ int retval;
+
+ printf("hello from c_sub1\n");
+
+ retval = func(10);
+ if(retval != 10)
+ {
+ fprintf(stderr, "Fortran function did not return expected value!\n");
+ abort();
+ }
+
+ return;
+}
Index: gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/c_funloc_tests_4.f03 (revision 0)
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-additional-sources c_funloc_tests_4_driver.c }
+! Test that the inlined c_funloc works.
+module c_funloc_tests_4
+ use, intrinsic :: iso_c_binding, only: c_funloc, c_funptr
+ interface
+ subroutine c_sub0(fsub_ptr) bind(c)
+ use, intrinsic :: iso_c_binding, only: c_funptr
+ type(c_funptr), value :: fsub_ptr
+ end subroutine c_sub0
+ subroutine c_sub1(ffunc_ptr) bind(c)
+ use, intrinsic :: iso_c_binding, only: c_funptr
+ type(c_funptr), value :: ffunc_ptr
+ end subroutine c_sub1
+ end interface
+contains
+ subroutine sub0() bind(c)
+ type(c_funptr) :: my_c_funptr
+
+ my_c_funptr = c_funloc(sub1)
+ call c_sub0(my_c_funptr)
+
+ my_c_funptr = c_funloc(func0)
+ call c_sub1(my_c_funptr)
+ end subroutine sub0
+
+ subroutine sub1() bind(c)
+ print *, 'hello from sub1'
+ end subroutine sub1
+
+ function func0(desired_retval) bind(c)
+ use, intrinsic :: iso_c_binding, only: c_int
+ integer(c_int), value :: desired_retval
+ integer(c_int) :: func0
+ print *, 'hello from func0'
+ func0 = desired_retval
+ end function func0
+end module c_funloc_tests_4
+! { dg-final { cleanup-modules "c_funloc_tests_4" } }
+
Index: gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/c_funloc_tests_5.f03 (revision 0)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! Test that the arg checking for c_funloc verifies the procedures are
+! C interoperable.
+module c_funloc_tests_5
+ use, intrinsic :: iso_c_binding, only: c_funloc, c_funptr
+contains
+ subroutine sub0() bind(c)
+ type(c_funptr) :: my_c_funptr
+
+ my_c_funptr = c_funloc(sub1) ! { dg-error "must be BIND.C." }
+
+ my_c_funptr = c_funloc(func0) ! { dg-error "must be BIND.C." }
+ end subroutine sub0
+
+ subroutine sub1()
+ end subroutine sub1
+
+ function func0(desired_retval)
+ use, intrinsic :: iso_c_binding, only: c_int
+ integer(c_int), value :: desired_retval
+ integer(c_int) :: func0
+ func0 = desired_retval
+ end function func0
+end module c_funloc_tests_5
+
+
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 126797)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2060,31 +2055,40 @@ gfc_conv_function_call (gfc_se * se, gfc
var = NULL_TREE;
len = NULL_TREE;
- if (sym->from_intmod == INTMOD_ISO_C_BINDING
- && sym->intmod_sym_id == ISOCBINDING_LOC)
+ if (sym->from_intmod == INTMOD_ISO_C_BINDING)
{
- if (arg->expr->rank == 0)
+ if (sym->intmod_sym_id == ISOCBINDING_LOC)
{
- gfc_conv_expr_reference (se, arg->expr);
+ if (arg->expr->rank == 0)
+ gfc_conv_expr_reference (se, arg->expr);
+ else
+ {
+ int f;
+ /* This is really the actual arg because no formal arglist is
+ created for C_LOC. */
+ fsym = arg->expr->symtree->n.sym;
+
+ /* We should want it to do g77 calling convention. */
+ f = (fsym != NULL)
+ && !(fsym->attr.pointer || fsym->attr.allocatable)
+ && fsym->as->type != AS_ASSUMED_SHAPE;
+ f = f || !sym->attr.always_explicit;
+
+ argss = gfc_walk_expr (arg->expr);
+ gfc_conv_array_parameter (se, arg->expr, argss, f);
+ }
+
+ return 0;
}
- else
+ else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
{
- int f;
- /* This is really the actual arg because no formal arglist is
- created for C_LOC. */
- fsym = arg->expr->symtree->n.sym;
-
- /* We should want it to do g77 calling convention. */
- f = (fsym != NULL)
- && !(fsym->attr.pointer || fsym->attr.allocatable)
- && fsym->as->type != AS_ASSUMED_SHAPE;
- f = f || !sym->attr.always_explicit;
-
- argss = gfc_walk_expr (arg->expr);
- gfc_conv_array_parameter (se, arg->expr, argss, f);
+ arg->expr->ts.type = sym->ts.derived->ts.type;
+ arg->expr->ts.f90_type = sym->ts.derived->ts.f90_type;
+ arg->expr->ts.kind = sym->ts.derived->ts.kind;
+ gfc_conv_expr_reference (se, arg->expr);
+
+ return 0;
}
-
- return 0;
}
if (se->ss != NULL)
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c (revision 126797)
+++ gcc/fortran/trans-types.c (working copy)
@@ -60,6 +60,7 @@ tree gfc_character1_type_node;
tree pvoid_type_node;
tree ppvoid_type_node;
tree pchar_type_node;
+tree pfunc_type_node;
tree gfc_charlen_type_node;
@@ -733,6 +734,8 @@ gfc_init_types (void)
pvoid_type_node = build_pointer_type (void_type_node);
ppvoid_type_node = build_pointer_type (pvoid_type_node);
pchar_type_node = build_pointer_type (gfc_character1_type_node);
+ pfunc_type_node
+ = build_pointer_type (build_function_type (void_type_node, NULL_TREE));
gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
/* We cannot use gfc_index_zero_node in definition of gfc_array_range_type,
@@ -842,7 +845,13 @@ gfc_typenode_for_spec (gfc_typespec * sp
has been resolved. This is done so we can convert C_PTR and
C_FUNPTR to simple variables that get translated to (void *). */
if (spec->f90_type == BT_VOID)
- basetype = ptr_type_node;
+ {
+ if (spec->derived
+ && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+ basetype = ptr_type_node;
+ else
+ basetype = pfunc_type_node;
+ }
else
basetype = gfc_get_int_type (spec->kind);
break;
@@ -878,9 +887,17 @@ gfc_typenode_for_spec (gfc_typespec * sp
}
break;
case BT_VOID:
- /* This is for the second arg to c_f_pointer and c_f_procpointer
- of the iso_c_binding module, to accept any ptr type. */
- basetype = ptr_type_node;
+ /* This is for the second arg to c_f_pointer and c_f_procpointer
+ of the iso_c_binding module, to accept any ptr type. */
+ basetype = ptr_type_node;
+ if (spec->f90_type == BT_VOID)
+ {
+ if (spec->derived
+ && spec->derived->intmod_sym_id == ISOCBINDING_PTR)
+ basetype = ptr_type_node;
+ else
+ basetype = pfunc_type_node;
+ }
break;
default:
gcc_unreachable ();
@@ -1653,7 +1670,10 @@ gfc_get_derived_type (gfc_symbol * deriv
/* See if it's one of the iso_c_binding derived types. */
if (derived->attr.is_iso_c == 1)
{
- derived->backend_decl = ptr_type_node;
+ if (derived->intmod_sym_id == ISOCBINDING_PTR)
+ derived->backend_decl = ptr_type_node;
+ else
+ derived->backend_decl = pfunc_type_node;
derived->ts.kind = gfc_index_integer_kind;
derived->ts.type = BT_INTEGER;
/* Set the f90_type to BT_VOID as a way to recognize something of type
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 126797)
+++ gcc/fortran/resolve.c (working copy)
@@ -1870,14 +1904,14 @@ gfc_iso_c_func_interface (gfc_symbol *sy
&(args->expr->where));
retval = FAILURE;
}
- else if (args->expr->symtree->n.sym->attr.is_c_interop != 1)
- {
- gfc_error_now ("Parameter '%s' to '%s' at %L must be C "
- "interoperable",
- args->expr->symtree->n.sym->name, sym->name,
- &(args->expr->where));
- retval = FAILURE;
- }
+ else if (args->expr->symtree->n.sym->attr.is_bind_c != 1)
+ {
+ gfc_error_now ("Parameter '%s' to '%s' at %L must be "
+ "BIND(C)",
+ args->expr->symtree->n.sym->name, sym->name,
+ &(args->expr->where));
+ retval = FAILURE;
+ }
}
/* for c_loc/c_funloc, the new symbol is the same as the old one */
Index: libgfortran/intrinsics/iso_c_binding.c
===================================================================
--- libgfortran/intrinsics/iso_c_binding.c (revision 126797)
+++ libgfortran/intrinsics/iso_c_binding.c (working copy)
@@ -211,22 +232,3 @@ ISO_C_BINDING_PREFIX (c_associated_2) (v
else
return 1;
}
-
-
-/* Return the C address of the given Fortran procedure. This
- routine is expected to return a derived type of type C_FUNPTR,
- which represents the C address of the given Fortran object. */
-
-void *
-ISO_C_BINDING_PREFIX (c_funloc) (void *f90_obj)
-{
- if (f90_obj == NULL)
- {
- runtime_error ("C_LOC: Attempt to get C address for Fortran object"
- " that has not been allocated or associated");
- abort ();
- }
-
- /* The "C" address should be the address of the object in Fortran. */
- return f90_obj;
-}
Index: libgfortran/intrinsics/iso_c_binding.h
===================================================================
--- libgfortran/intrinsics/iso_c_binding.h (revision 126797)
+++ libgfortran/intrinsics/iso_c_binding.h (working copy)
@@ -64,6 +64,4 @@ void ISO_C_BINDING_PREFIX(c_f_pointer_u0
void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *,
const array_t *);
-void *ISO_C_BINDING_PREFIX(c_funloc) (void *);
-
#endif
Index: libgfortran/gfortran.map
===================================================================
--- libgfortran/gfortran.map (revision 126797)
+++ libgfortran/gfortran.map (working copy)
@@ -1016,9 +1016,17 @@ GFORTRAN_1.0 {
__iso_c_binding_c_f_pointer_r8;
__iso_c_binding_c_f_pointer_r10;
__iso_c_binding_c_f_pointer_r16;
+ __iso_c_binding_c_f_pointer_c4;
+ __iso_c_binding_c_f_pointer_c8;
+ __iso_c_binding_c_f_pointer_c10;
+ __iso_c_binding_c_f_pointer_c16;
+ __iso_c_binding_c_f_pointer_s0;
+ __iso_c_binding_c_f_pointer_l1;
+ __iso_c_binding_c_f_pointer_l2;
+ __iso_c_binding_c_f_pointer_l4;
+ __iso_c_binding_c_f_pointer_l8;
__iso_c_binding_c_f_pointer_u0;
__iso_c_binding_c_f_procpointer;
- __iso_c_binding_c_funloc;
local:
*;
};