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

4 files changed, 57 insertions, 25 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7ee3b07..d9885ae 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2461bc3..65e479f 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 d6bd963..ae97a65 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 dff1fd8..a1f1ee9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2110,6 +2110,52 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
       
 	  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)