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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@129367
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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 */
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);
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;
+ }
}
if (se->ss != NULL)
+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
_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;
}
-/* 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;
-}
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 *,
OSDN Git Service
