OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/32600 ([ISO Bind C] C_F_POINTER w/o SHAPE should not be a library function) 

2007-10-15 Christopher D. Rickett <crickett@lanl.gov>

        PR fortran/32600
        * trans-expr.c (gfc_conv_function_call): Generate code to inline
        c_associated.
        * symbol.c (get_iso_c_sym): Preserve from_intmod and
        * intmod_sym_id
        attributes in the resolved symbol.
        * resolve.c (gfc_iso_c_sub_interface): Remove dead code.


2007-10-15 Christopher D. Rickett <crickett@lanl.gov>

        PR fortran/32600
        * libgfortran/intrinsics/iso_c_binding.c: Remove c_associated_1
        and c_associated_2.
        * libgfortran/intrinsics/iso_c_binding.h: Ditto.
        * libgfortran/gfortran.map: Ditto.

From-SVN: r129367
This commit is contained in:
Christopher D. Rickett 2007-10-15 19:58:55 +00:00 committed by Tobias Burnus
parent 93f238cea1
commit 9fd25b5cd5
8 changed files with 65 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2007-10-15 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32600
* trans-expr.c (gfc_conv_function_call): Generate code to inline
c_associated.
* symbol.c (get_iso_c_sym): Preserve from_intmod and intmod_sym_id
attributes in the resolved symbol.
* resolve.c (gfc_iso_c_sub_interface): Remove dead code.
2007-10-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/33055

25
gcc/fortran/resolve.c
View File

@ -2479,31 +2479,6 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
new_sym->declared_at = sym->declared_at;
}
}
else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
/* TODO: Figure out if this is even reachable; this part of the
conditional may not be necessary. */
int num_args = 0;
if (c->ext.actual->next == NULL)
{
/* The user did not give two args, so resolve to the version
of c_associated expecting one arg. */
num_args = 1;
/* get rid of the second arg */
/* TODO!! Should free up the memory here! */
sym->formal->next = NULL;
}
else
{
num_args = 2;
}
new_sym = sym;
sprintf (name, "%s_%d", sym->name, num_args);
sprintf (binding_label, "%s_%d", sym->binding_label, num_args);
sym->name = gfc_get_string (name);
strcpy (sym->binding_label, binding_label);
}
else
{
/* no differences for c_loc or c_funloc */

2
gcc/fortran/symbol.c
View File

@ -4029,6 +4029,8 @@ get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
new_symtree->n.sym->attr = old_sym->attr;
new_symtree->n.sym->ts = old_sym->ts;
new_symtree->n.sym->module = gfc_get_string (old_sym->module);
new_symtree->n.sym->from_intmod = old_sym->from_intmod;
new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id;
/* Build the formal arg list. */
build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);

46
gcc/fortran/trans-expr.c
View File

@ -2108,6 +2108,52 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
arg->expr->ts.kind = sym->ts.derived->ts.kind;
gfc_conv_expr_reference (se, arg->expr);
return 0;
}
else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
{
gfc_se arg1se;
gfc_se arg2se;
/* Build the addr_expr for the first argument. The argument is
already an *address* so we don't need to set want_pointer in
the gfc_se. */
gfc_init_se (&arg1se, NULL);
gfc_conv_expr (&arg1se, arg->expr);
gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post);
/* See if we were given two arguments. */
if (arg->next == NULL)
/* Only given one arg so generate a null and do a
not-equal comparison against the first arg. */
se->expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr,
fold_convert (TREE_TYPE (arg1se.expr),
null_pointer_node));
else
{
tree eq_expr;
tree not_null_expr;
/* Given two arguments so build the arg2se from second arg. */
gfc_init_se (&arg2se, NULL);
gfc_conv_expr (&arg2se, arg->next->expr);
gfc_add_block_to_block (&se->pre, &arg2se.pre);
gfc_add_block_to_block (&se->post, &arg2se.post);
/* Generate test to compare that the two args are equal. */
eq_expr = build2 (EQ_EXPR, boolean_type_node, arg1se.expr,
arg2se.expr);
/* Generate test to ensure that the first arg is not null. */
not_null_expr = build2 (NE_EXPR, boolean_type_node, arg1se.expr,
null_pointer_node);
/* Finally, the generated test must check that both arg1 is not
NULL and that it is equal to the second arg. */
se->expr = build2 (TRUTH_AND_EXPR, boolean_type_node,
not_null_expr, eq_expr);
}
return 0;
}
}

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2007-10-15 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32600
* libgfortran/intrinsics/iso_c_binding.c: Remove c_associated_1
and c_associated_2.
* libgfortran/intrinsics/iso_c_binding.h: Ditto.
* libgfortran/gfortran.map: Ditto.
2007-10-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/33055

2
libgfortran/gfortran.map
View File

@ -1003,8 +1003,6 @@ GFORTRAN_1.0 {
_gfortran_unpack0_char;
_gfortran_unpack1;
_gfortran_unpack1_char;
__iso_c_binding_c_associated_1;
__iso_c_binding_c_associated_2;
__iso_c_binding_c_f_pointer;
__iso_c_binding_c_f_pointer_d0;
__iso_c_binding_c_f_pointer_i1;

39
libgfortran/intrinsics/iso_c_binding.c
View File

@ -193,42 +193,3 @@ ISO_C_BINDING_PREFIX (c_f_procpointer) (void *c_ptr_in,
}
/* Test if the given c_ptr is associated or not. This function is
called if the user only supplied one c_ptr parameter to the
c_associated function. The second argument is optional, and the
Fortran compiler will resolve the function to this version if only
one arg was given. Associated here simply means whether or not the
c_ptr is NULL or not. */
GFC_LOGICAL_4
ISO_C_BINDING_PREFIX (c_associated_1) (void *c_ptr_in_1)
{
if (c_ptr_in_1 != NULL)
return 1;
else
return 0;
}
/* Test if the two c_ptr arguments are associated with one another.
This version of the c_associated function is called if the user
supplied two c_ptr args in the Fortran source. According to the
draft standard (J3/04-007), if c_ptr_in_1 is NULL, the two pointers
are NOT associated. If c_ptr_in_1 is non-NULL and it is not equal
to c_ptr_in_2, then either c_ptr_in_2 is NULL or is associated with
another address; either way, the two pointers are not associated
with each other then. */
GFC_LOGICAL_4
ISO_C_BINDING_PREFIX (c_associated_2) (void *c_ptr_in_1, void *c_ptr_in_2)
{
/* Since we have the second arg, if it doesn't equal the first,
return false; true otherwise. However, if the first one is null,
then return false; otherwise compare the two ptrs for equality. */
if (c_ptr_in_1 == NULL)
return 0;
else if (c_ptr_in_1 != c_ptr_in_2)
return 0;
else
return 1;
}

3
libgfortran/intrinsics/iso_c_binding.h
View File

@ -56,9 +56,6 @@ void ISO_C_BINDING_PREFIX(c_f_pointer)(void *, gfc_array_void *,
implemented. */
void ISO_C_BINDING_PREFIX(c_f_procpointer) (void *, gfc_array_void *);
GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_1) (void *);
GFC_LOGICAL_4 ISO_C_BINDING_PREFIX(c_associated_2) (void *, void *);
void ISO_C_BINDING_PREFIX(c_f_pointer_u0) (void *, gfc_array_void *,
const array_t *);
void ISO_C_BINDING_PREFIX(c_f_pointer_d0) (void *, gfc_array_void *,