[Patch, fortran] [1/4] C binding access to C_PTR type: preliminary cleanups

[Mikael Morin <mikael dot morin at sfr dot fr>]

This patch contains some preliminary cleanup.
 - generate_isocbinding_symbol handles NULL symbol names just fine.
Thus, there is no need to pass explicitly the "c_ptr" or "c_funptr"
strings.
 - There is a lot of code that looks like
	if (cond)
	  {
	    foo (c_ptr);
	    bar (c_ptr);
	  }
	else
	  {
	    foo (c_funptr);
	    bar (c_funptr);
	  }

That code is changed by this patch to:
	if (cond)
	  ptr_id = c_ptr_id;
	else
	  ptr_id = c_funptr_id;
	  
	foo (ptr_id);
	bar (ptr_id);

Attachment: pr55574_v20-1.CL
Description: Text document

diff --git a/symbol.c b/symbol.c
index acfebc5..4e6004f 100644
--- a/symbol.c
+++ b/symbol.c
@@ -3817,6 +3817,7 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   gfc_symtree *tmp_symtree;
   gfc_symbol *tmp_sym;
   gfc_constructor *c;
+  iso_c_binding_symbol type_id;
 
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
 	 
@@ -3838,25 +3839,19 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   /* The c_ptr and c_funptr derived types will provide the
      definition for c_null_ptr and c_null_funptr, respectively.  */
   if (ptr_id == ISOCBINDING_NULL_PTR)
-    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+    type_id = ISOCBINDING_PTR;
   else
-    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+    type_id = ISOCBINDING_FUNPTR;
+  tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
   if (tmp_sym->ts.u.derived == NULL)
     {
       /* This can occur if the user forgot to declare c_ptr or
-         c_funptr and they're trying to use one of the procedures
-         that has arg(s) of the missing type.  In this case, a
-         regular version of the thing should have been put in the
-         current ns.  */
-
-      generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR 
-                                   ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
-                                   (const char *) (ptr_id == ISOCBINDING_NULL_PTR 
-				   ? "c_ptr"
-				   : "c_funptr"));
-      tmp_sym->ts.u.derived =
-	get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
-			      ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
+	 c_funptr and they're trying to use one of the procedures
+	 that has arg(s) of the missing type.  In this case, a
+	 regular version of the thing should have been put in the
+	 current ns.  */
+      generate_isocbinding_symbol (module_name, type_id, NULL);
+      tmp_sym->ts.u.derived = get_iso_c_binding_dt (type_id);
     }
 
   /* Module name is some mangled version of iso_c_binding.  */
@@ -3929,6 +3924,7 @@ gen_cptr_param (gfc_formal_arglist **head,
   gfc_formal_arglist *formal_arg = NULL;
   const char *c_ptr_in;
   const char *c_ptr_type = NULL;
+  iso_c_binding_symbol c_ptr_id;
 
   if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
     c_ptr_type = "c_funptr";
@@ -3957,23 +3953,18 @@ gen_cptr_param (gfc_formal_arglist **head,
   param_sym->attr.value = 1;
   param_sym->attr.use_assoc = 1;
 
-  /* Get the symbol for c_ptr or c_funptr, no matter what it's name is 
+  /* Get the symbol for c_ptr or c_funptr, no matter what it's name is
      (user renamed).  */
   if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+    c_ptr_id = ISOCBINDING_FUNPTR;
   else
-    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR);
+    c_ptr_id = ISOCBINDING_PTR;
+  c_ptr_sym = get_iso_c_binding_dt (c_ptr_id);
   if (c_ptr_sym == NULL)
     {
       /* This can happen if the user did not define c_ptr but they are
-         trying to use one of the iso_c_binding functions that need it.  */
-      if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-	generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR,
-				     (const char *)c_ptr_type);
-      else
-	generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
-				     (const char *)c_ptr_type);
-
+	 trying to use one of the iso_c_binding functions that need it.  */
+      generate_isocbinding_symbol (module_name, c_ptr_id, NULL);
       gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
     }
 
@@ -4556,31 +4547,25 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	      }
 	    else
 	      {
-               /* Here, we're taking the simple approach.  We're defining
-                  c_loc as an external identifier so the compiler will put
-                  what we expect on the stack for the address we want the
-                  C address of.  */
+		iso_c_binding_symbol c_ptr_id;
+
+		/* Here, we're taking the simple approach.  We're defining
+		   c_loc as an external identifier so the compiler will put
+		   what we expect on the stack for the address we want the
+		   C address of.  */
 		tmp_sym->ts.type = BT_DERIVED;
-                if (s == ISOCBINDING_LOC)
-                  tmp_sym->ts.u.derived =
-                    get_iso_c_binding_dt (ISOCBINDING_PTR);
-                else
-                  tmp_sym->ts.u.derived =
-                    get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+		if (s == ISOCBINDING_LOC)
+		  c_ptr_id = ISOCBINDING_PTR;
+		else
+		  c_ptr_id = ISOCBINDING_FUNPTR;
 
+		tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
 		if (tmp_sym->ts.u.derived == NULL)
 		  {
-                    /* Create the necessary derived type so we can continue
-                       processing the file.  */
-		    generate_isocbinding_symbol
-		      (mod_name, s == ISOCBINDING_FUNLOC
-				? ISOCBINDING_FUNPTR : ISOCBINDING_PTR,
-		      (const char *)(s == ISOCBINDING_FUNLOC
-				? "c_funptr" : "c_ptr"));
-                    tmp_sym->ts.u.derived =
-		    get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
-					    ? ISOCBINDING_FUNPTR
-					    : ISOCBINDING_PTR);
+		    /* Create the necessary derived type so we can continue
+		       processing the file.  */
+		    generate_isocbinding_symbol (mod_name, c_ptr_id, NULL);
+		    tmp_sym->ts.u.derived = get_iso_c_binding_dt (c_ptr_id);
 		  }
 
 		/* The function result is itself (no result clause).  */