diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7ee3b07b44a..d9885ae7dd0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-10-15 Christopher D. Rickett + + 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 PR fortran/33055 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2461bc3beeb..65e479fe65f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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 */ diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index d6bd9638df6..ae97a656759 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index dff1fd8fcc1..a1f1ee957db 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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; } } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 34df5007e92..d0cecb0167b 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2007-10-15 Christopher D. Rickett + + 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 PR libfortran/33055 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 429c84c8c4a..b9f4aa93b73 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -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; diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index 5d566bcf11b..2a1e994d4d9 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -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; -} diff --git a/libgfortran/intrinsics/iso_c_binding.h b/libgfortran/intrinsics/iso_c_binding.h index 206359ad8c9..4679c2aba02 100644 --- a/libgfortran/intrinsics/iso_c_binding.h +++ b/libgfortran/intrinsics/iso_c_binding.h @@ -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 *,