PR 51808 Support arbitrarily long bind(C) binding labels.

2012-01-29  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/51808
	* decl.c (set_binding_label): Move prototype from match.h to here.
	(curr_binding_label): Make a pointer rather than static array.
	(build_sym): Check sym->binding_label pointer rather than array,
	update set_binding_label call, handle curr_binding_label changes.
	(set_binding_label): Handle new curr_binding_label, dest_label
	double ptr, and sym->binding_label.
	(verify_bind_c_sym): Handle sym->binding_label being a pointer.
	(set_verify_bind_c_sym): Check sym->binding_label pointer rather
	than array, update set_binding_label call.
	(gfc_match_bind_c_stmt): Handle curr_binding_label change.
	(match_procedure_decl): Update set_binding_label call.
	(gfc_match_bind_c): Change binding_label to pointer, update
	gfc_match_name_C call.
	* gfortran.h (GFC_MAX_BINDING_LABEL_LEN): Remove macro.
	(gfc_symbol): Make binding_label a pointer.
	(gfc_common_head): Likewise.
	* match.c (gfc_match_name_C): Heap allocate bind(C) name.
	* match.h (gfc_match_name_C): Change prototype argument.
	(set_binding_label): Move prototype to decl.c.
	* module.c (struct pointer_info): Make binding_label a pointer.
	(free_pi_tree): Free unused binding_label.
	(mio_read_string): New function.
	(mio_write_string): New function.
	(load_commons): Redo reading of binding_label.
	(read_module): Likewise.
	(write_common_0): Change to write empty string instead of name if
	no binding_label.
	(write_blank_common): Write empty string for binding label.
	(write_symbol): Change to write empty string instead of name if no
	binding_label.
	* resolve.c (gfc_iso_c_func_interface): Don't set binding_label.
	(set_name_and_label): Make binding_label double pointer, use
	asprintf.
	(gfc_iso_c_sub_interface): Make binding_label a pointer.
	(resolve_bind_c_comms): Handle cases if
	gfc_common_head->binding_label is NULL.
	(gfc_verify_binding_labels): sym->binding_label is a pointer.
	* symbol.c (gfc_free_symbol): Free binding_label.
	(gfc_new_symbol): Rely on XCNEW zero init for binding_label.
	(gen_special_c_interop_ptr): Don't set binding label.
	(generate_isocbinding_symbol): Insert binding_label into symbol
	table.
	(get_iso_c_sym): Use pointer assignment instead of strcpy.
	* trans-common.c (gfc_sym_mangled_common_id): Handle
	com->binding_label being a pointer.
	* trans-decl.c (gfc_sym_mangled_identifier): Handle
	sym->binding_label being a pointer.
	(gfc_sym_mangled_function_id): Likewise.


testsuite ChangeLog

2012-01-29  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/51808
	* gfortran.dg/module_md5_1.f90: Update MD5 sum.

From-SVN: r183677

gcc/fortran/ChangeLog

+2012-01-29  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/51808
+	* decl.c (set_binding_label): Move prototype from match.h to here.
+	(curr_binding_label): Make a pointer rather than static array.
+	(build_sym): Check sym->binding_label pointer rather than array,
+	update set_binding_label call, handle curr_binding_label changes.
+	(set_binding_label): Handle new curr_binding_label, dest_label
+	double ptr, and sym->binding_label.
+	(verify_bind_c_sym): Handle sym->binding_label being a pointer.
+	(set_verify_bind_c_sym): Check sym->binding_label pointer rather
+	than array, update set_binding_label call.
+	(gfc_match_bind_c_stmt): Handle curr_binding_label change.
+	(match_procedure_decl): Update set_binding_label call.
+	(gfc_match_bind_c): Change binding_label to pointer, update
+	gfc_match_name_C call.
+	* gfortran.h (GFC_MAX_BINDING_LABEL_LEN): Remove macro.
+	(gfc_symbol): Make binding_label a pointer.
+	(gfc_common_head): Likewise.
+	* match.c (gfc_match_name_C): Heap allocate bind(C) name.
+	* match.h (gfc_match_name_C): Change prototype argument.
+	(set_binding_label): Move prototype to decl.c.
+	* module.c (struct pointer_info): Make binding_label a pointer.
+	(free_pi_tree): Free unused binding_label.
+	(mio_read_string): New function.
+	(mio_write_string): New function.
+	(load_commons): Redo reading of binding_label.
+	(read_module): Likewise.
+	(write_common_0): Change to write empty string instead of name if
+	no binding_label.
+	(write_blank_common): Write empty string for binding label.
+	(write_symbol): Change to write empty string instead of name if no
+	binding_label.
+	* resolve.c (gfc_iso_c_func_interface): Don't set binding_label.
+	(set_name_and_label): Make binding_label double pointer, use
+	asprintf.
+	(gfc_iso_c_sub_interface): Make binding_label a pointer.
+	(resolve_bind_c_comms): Handle cases if
+	gfc_common_head->binding_label is NULL.
+	(gfc_verify_binding_labels): sym->binding_label is a pointer.
+	* symbol.c (gfc_free_symbol): Free binding_label.
+	(gfc_new_symbol): Rely on XCNEW zero init for binding_label.
+	(gen_special_c_interop_ptr): Don't set binding label.
+	(generate_isocbinding_symbol): Insert binding_label into symbol
+	table.
+	(get_iso_c_sym): Use pointer assignment instead of strcpy.
+	* trans-common.c (gfc_sym_mangled_common_id): Handle
+	com->binding_label being a pointer.
+	* trans-decl.c (gfc_sym_mangled_identifier): Handle
+	sym->binding_label being a pointer.
+	(gfc_sym_mangled_function_id): Likewise.
+
 2012-01-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/52038
@@ -22,7 +74,7 @@
 	* resolve.c (resolve_formal_arglist): Fix elemental
 	constraint checks for polymorphic dummies also for
 	pointers.
-	
+
 2012-01-27  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51970

gcc/fortran/decl.c

@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "parse.h"
 #include "flags.h"
 #include "constructor.h"
+#include "tree.h"
 
 /* Macros to access allocate memory for gfc_data_variable,
    gfc_data_value and gfc_data.  */
@@ -34,6 +35,9 @@ along with GCC; see the file COPYING3.  If not see
 #define gfc_get_data() XCNEW (gfc_data)
 
 
+static gfc_try set_binding_label (char **, const char *, int);
+
+
 /* This flag is set if an old-style length selector is matched
    during a type-declaration statement.  */
 
@@ -51,7 +55,7 @@ static gfc_array_spec *current_as;
 static int colon_seen;
 
 /* The current binding label (if any).  */
-static char curr_binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+static char* curr_binding_label;
 /* Need to know how many identifiers are on the current data declaration
    line in case we're given the BIND(C) attribute with a NAME= specifier.  */
 static int num_idents_on_line;
@@ -1164,11 +1168,11 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
      with a bind(c) and make sure the binding label is set correctly.  */
   if (sym->attr.is_bind_c == 1)
     {
-      if (sym->binding_label[0] == '\0')
+      if (!sym->binding_label)
         {
 	  /* Set the binding label and verify that if a NAME= was specified
 	     then only one identifier was in the entity-decl-list.  */
-	  if (set_binding_label (sym->binding_label, sym->name,
+	  if (set_binding_label (&sym->binding_label, sym->name,
 				 num_idents_on_line) == FAILURE)
             return FAILURE;
         }
@@ -2575,7 +2579,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
     ts->kind = -1;
 
   /* Clear the current binding label, in case one is given.  */
-  curr_binding_label[0] = '\0';
+  curr_binding_label = NULL;
 
   if (gfc_match (" byte") == MATCH_YES)
     {
@@ -3803,8 +3807,8 @@ cleanup:
    (J3/04-007, section 15.4.1).  If a binding label was given and
    there is more than one argument (num_idents), it is an error.  */
 
-gfc_try
-set_binding_label (char *dest_label, const char *sym_name, int num_idents)
+static gfc_try
+set_binding_label (char **dest_label, const char *sym_name, int num_idents)
 {
   if (num_idents > 1 && has_name_equals)
     {
@@ -3813,17 +3817,15 @@ set_binding_label (char *dest_label, const char *sym_name, int num_idents)
       return FAILURE;
     }
 
-  if (curr_binding_label[0] != '\0')
-    {
-      /* Binding label given; store in temp holder til have sym.  */
-      strcpy (dest_label, curr_binding_label);
-    }
+  if (curr_binding_label)
+    /* Binding label given; store in temp holder til have sym.  */
+    *dest_label = curr_binding_label;
   else
     {
       /* No binding label given, and the NAME= specifier did not exist,
          which means there was no NAME="".  */
       if (sym_name != NULL && has_name_equals == 0)
-        strcpy (dest_label, sym_name);
+        *dest_label = IDENTIFIER_POINTER (get_identifier (sym_name));
     }
    
   return SUCCESS;
@@ -4003,7 +4005,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
   /* See if the symbol has been marked as private.  If it has, make sure
      there is no binding label and warn the user if there is one.  */
   if (tmp_sym->attr.access == ACCESS_PRIVATE
-      && tmp_sym->binding_label[0] != '\0')
+      && tmp_sym->binding_label)
       /* Use gfc_warning_now because we won't say that the symbol fails
 	 just because of this.	*/
       gfc_warning_now ("Symbol '%s' at %L is marked PRIVATE but has been "
@@ -4029,7 +4031,7 @@ set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents)
   /* Set the is_bind_c bit in symbol_attribute.  */
   gfc_add_is_bind_c (&(tmp_sym->attr), tmp_sym->name, &gfc_current_locus, 0);
 
-  if (set_binding_label (tmp_sym->binding_label, tmp_sym->name, 
+  if (set_binding_label (&tmp_sym->binding_label, tmp_sym->name,
 			 num_idents) != SUCCESS)
     return FAILURE;
 
@@ -4046,7 +4048,8 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents)
   gfc_try retval = SUCCESS;
   
   /* destLabel, common name, typespec (which may have binding label).  */
-  if (set_binding_label (com_block->binding_label, com_block->name, num_idents)
+  if (set_binding_label (&com_block->binding_label, com_block->name, 
+			 num_idents)
       != SUCCESS)
     return FAILURE;
 
@@ -4157,7 +4160,7 @@ gfc_match_bind_c_stmt (void)
   /* This may not be necessary.  */
   gfc_clear_ts (ts);
   /* Clear the temporary binding label holder.  */
-  curr_binding_label[0] = '\0';
+  curr_binding_label = NULL;
 
   /* Look for the bind(c).  */
   found_match = gfc_match_bind_c (NULL, true);
@@ -4865,7 +4868,8 @@ match_procedure_decl (void)
 	      return MATCH_ERROR;
 	    }
 	  /* Set binding label for BIND(C).  */
-	  if (set_binding_label (sym->binding_label, sym->name, num) != SUCCESS)
+	  if (set_binding_label (&sym->binding_label, sym->name, num) 
+	      != SUCCESS)
 	    return MATCH_ERROR;
 	}
 
@@ -5709,7 +5713,7 @@ match
 gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
 {
   /* binding label, if exists */   
-  char binding_label[GFC_MAX_SYMBOL_LEN + 1];
+  char* binding_label = NULL;
   match double_quote;
   match single_quote;
 
@@ -5717,10 +5721,6 @@ gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
      specifier or not.  */
   has_name_equals = 0;
 
-  /* Init the first char to nil so we can catch if we don't have
-     the label (name attr) or the symbol name yet.  */
-  binding_label[0] = '\0';
-   
   /* This much we have to be able to match, in this order, if
      there is a bind(c) label.	*/
   if (gfc_match (" bind ( c ") != MATCH_YES)
@@ -5755,7 +5755,7 @@ gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
       
       /* Grab the binding label, using functions that will not lower
 	 case the names automatically.	*/
-      if (gfc_match_name_C (binding_label) != MATCH_YES)
+      if (gfc_match_name_C (&binding_label) != MATCH_YES)
 	 return MATCH_ERROR;
       
       /* Get the closing quotation.  */
@@ -5803,14 +5803,12 @@ gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
   /* Save the binding label to the symbol.  If sym is null, we're
      probably matching the typespec attributes of a declaration and
      haven't gotten the name yet, and therefore, no symbol yet.	 */
-  if (binding_label[0] != '\0')
+  if (binding_label)
     {
       if (sym != NULL)
-      {
-	strcpy (sym->binding_label, binding_label);
-      }
+	sym->binding_label = binding_label;
       else
-	strcpy (curr_binding_label, binding_label);
+	curr_binding_label = binding_label;
     }
   else if (allow_binding_name)
     {
@@ -5819,7 +5817,7 @@ gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
 	 If name="" or allow_binding_name is false, no C binding name is
 	 created. */
       if (sym != NULL && sym->name != NULL && has_name_equals == 0)
-	strncpy (sym->binding_label, sym->name, strlen (sym->name) + 1);
+	sym->binding_label = IDENTIFIER_POINTER (get_identifier (sym->name));
     }
 
   if (has_name_equals && gfc_current_state () == COMP_INTERFACE

gcc/fortran/gfortran.h

@@ -42,7 +42,6 @@ along with GCC; see the file COPYING3.  If not see
 /* Major control parameters.  */
 
 #define GFC_MAX_SYMBOL_LEN 63   /* Must be at least 63 for F2003.  */
-#define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
 #define GFC_MAX_LINE 132	/* Characters beyond this are not seen.  */
 #define GFC_LETTERS 26		/* Number of letters in the alphabet.  */
 
@@ -1238,7 +1237,7 @@ typedef struct gfc_symbol
 
   /* This may be repetitive, since the typespec now has a binding
      label field.  */
-  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  char* binding_label;
   /* Store a reference to the common_block, if this symbol is in one.  */
   struct gfc_common_head *common_block;
 
@@ -1255,7 +1254,7 @@ typedef struct gfc_common_head
   char use_assoc, saved, threadprivate;
   char name[GFC_MAX_SYMBOL_LEN + 1];
   struct gfc_symbol *head;
-  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  char* binding_label;
   int is_bind_c;
 }
 gfc_common_head;

gcc/fortran/match.c

 /* Matching subroutines in all sizes, shapes and colors.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010, 2011
+   2009, 2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -26,6 +26,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "match.h"
 #include "parse.h"
+#include "tree.h"
 
 int gfc_matching_ptr_assignment = 0;
 int gfc_matching_procptr_assignment = 0;
@@ -571,22 +572,22 @@ gfc_match_name (char *buffer)
 /* Match a valid name for C, which is almost the same as for Fortran,
    except that you can start with an underscore, etc..  It could have
    been done by modifying the gfc_match_name, but this way other
-   things C allows can be added, such as no limits on the length.
-   Right now, the length is limited to the same thing as Fortran..
+   things C allows can be done, such as no limits on the length.
    Also, by rewriting it, we use the gfc_next_char_C() to prevent the
    input characters from being automatically lower cased, since C is
    case sensitive.  The parameter, buffer, is used to return the name
-   that is matched.  Return MATCH_ERROR if the name is too long
-   (though this is a self-imposed limit), MATCH_NO if what we're
-   seeing isn't a name, and MATCH_YES if we successfully match a C
-   name.  */
+   that is matched.  Return MATCH_ERROR if the name is not a valid C
+   name, MATCH_NO if what we're seeing isn't a name, and MATCH_YES if
+   we successfully match a C name.  */
 
 match
-gfc_match_name_C (char *buffer)
+gfc_match_name_C (char **buffer)
 {
   locus old_loc;
-  int i = 0;
+  size_t i = 0;
   gfc_char_t c;
+  char* buf;
+  size_t cursz = 16; 
 
   old_loc = gfc_current_locus;
   gfc_gobble_whitespace ();
@@ -600,7 +601,6 @@ gfc_match_name_C (char *buffer)
      symbol name, all lowercase.  */
   if (c == '"' || c == '\'')
     {
-      buffer[0] = '\0';
       gfc_current_locus = old_loc;
       return MATCH_YES;
     }
@@ -611,24 +611,19 @@ gfc_match_name_C (char *buffer)
       return MATCH_ERROR;
     }
 
+  buf = XNEWVEC (char, cursz);
   /* Continue to read valid variable name characters.  */
   do
     {
       gcc_assert (gfc_wide_fits_in_byte (c));
 
-      buffer[i++] = (unsigned char) c;
-      
-    /* C does not define a maximum length of variable names, to my
-       knowledge, but the compiler typically places a limit on them.
-       For now, i'll use the same as the fortran limit for simplicity,
-       but this may need to be changed to a dynamic buffer that can
-       be realloc'ed here if necessary, or more likely, a larger
-       upper-bound set.  */
-      if (i > gfc_option.max_identifier_length)
-        {
-          gfc_error ("Name at %C is too long");
-          return MATCH_ERROR;
-        }
+      buf[i++] = (unsigned char) c;
+
+      if (i >= cursz)
+	{
+	  cursz *= 2;
+	  buf = XRESIZEVEC (char, buf, cursz);
+	}
       
       old_loc = gfc_current_locus;
       
@@ -636,7 +631,11 @@ gfc_match_name_C (char *buffer)
       c = gfc_next_char_literal (INSTRING_WARN);
     } while (ISALNUM (c) || c == '_');
 
-  buffer[i] = '\0';
+  /* The binding label will be needed later anyway, so just insert it
+     into the symbol table.  */
+  buf[i] = '\0';
+  *buffer = IDENTIFIER_POINTER (get_identifier (buf));
+  XDELETEVEC (buf);
   gfc_current_locus = old_loc;
 
   /* See if we stopped because of whitespace.  */

gcc/fortran/match.h

@@ -52,7 +52,7 @@ match gfc_match_label (void);
 match gfc_match_small_int (int *);
 match gfc_match_small_int_expr (int *, gfc_expr **);
 match gfc_match_name (char *);
-match gfc_match_name_C (char *buffer);
+match gfc_match_name_C (char **buffer);
 match gfc_match_symbol (gfc_symbol **, int);
 match gfc_match_sym_tree (gfc_symtree **, int);
 match gfc_match_intrinsic_op (gfc_intrinsic_op *);
@@ -196,7 +196,6 @@ match gfc_match_volatile (void);
 /* Fortran 2003 c interop.
    TODO: some of these should be moved to another file rather than decl.c */
 void set_com_block_bind_c (gfc_common_head *, int);
-gfc_try set_binding_label (char *, const char *, int);
 gfc_try set_verify_bind_c_sym (gfc_symbol *, int);
 gfc_try set_verify_bind_c_com_block (gfc_common_head *, int);
 gfc_try get_bind_c_idents (void);

gcc/fortran/module.c

@@ -75,6 +75,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "md5.h"
 #include "constructor.h"
 #include "cpp.h"
+#include "tree.h"
 
 #define MODULE_EXTENSION ".mod"
 
@@ -160,7 +161,7 @@ typedef struct pointer_info
       module_locus where;
       fixup_t *stfixup;
       gfc_symtree *symtree;
-      char binding_label[GFC_MAX_SYMBOL_LEN + 1];
+      char* binding_label;
     }
     rsym;
 
@@ -227,6 +228,9 @@ free_pi_tree (pointer_info *p)
   free_pi_tree (p->left);
   free_pi_tree (p->right);
 
+  if (iomode == IO_INPUT)
+    XDELETEVEC (p->u.rsym.binding_label);
+
   free (p);
 }
 
@@ -1812,6 +1816,27 @@ mio_internal_string (char *string)
 }
 
 
+/* Read a string. The caller is responsible for freeing.  */
+
+static char*
+mio_read_string (void)
+{
+  char* p;
+  require_atom (ATOM_STRING);
+  p = atom_string;
+  atom_string = NULL;
+  return p;
+}
+
+
+/* Write a string.  */
+static void
+mio_write_string (const char* string)
+{
+  write_atom (ATOM_STRING, string);
+}
+
+
 typedef enum
 { AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
   AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
@@ -4126,6 +4151,7 @@ load_commons (void)
   while (peek_atom () != ATOM_RPAREN)
     {
       int flags;
+      char* label;
       mio_lparen ();
       mio_internal_string (name);
 
@@ -4142,7 +4168,10 @@ load_commons (void)
       /* Get whether this was a bind(c) common or not.  */
       mio_integer (&p->is_bind_c);
       /* Get the binding label.  */
-      mio_internal_string (p->binding_label);
+      label = mio_read_string ();
+      if (strlen (label))
+	p->binding_label = IDENTIFIER_POINTER (get_identifier (label));
+      XDELETEVEC (label);
       
       mio_rparen ();
     }
@@ -4344,7 +4373,9 @@ load_needed (pointer_info *p)
       sym = gfc_new_symbol (p->u.rsym.true_name, ns);
       sym->name = dt_lower_string (p->u.rsym.true_name);
       sym->module = gfc_get_string (p->u.rsym.module);
-      strcpy (sym->binding_label, p->u.rsym.binding_label);
+      if (p->u.rsym.binding_label)
+	sym->binding_label = IDENTIFIER_POINTER (get_identifier 
+						 (p->u.rsym.binding_label));
 
       associate_integer_pointer (p, sym);
     }
@@ -4493,6 +4524,7 @@ read_module (void)
 
   while (peek_atom () != ATOM_RPAREN)
     {
+      char* bind_label;
       require_atom (ATOM_INTEGER);
       info = get_integer (atom_int);
 
@@ -4501,8 +4533,11 @@ read_module (void)
 
       mio_internal_string (info->u.rsym.true_name);
       mio_internal_string (info->u.rsym.module);
-      mio_internal_string (info->u.rsym.binding_label);
-
+      bind_label = mio_read_string ();
+      if (strlen (bind_label))
+	info->u.rsym.binding_label = bind_label;
+      else
+	XDELETEVEC (bind_label);
       
       require_atom (ATOM_INTEGER);
       info->u.rsym.ns = atom_int;
@@ -4634,10 +4669,10 @@ read_module (void)
 		  sym = info->u.rsym.sym;
 		  sym->module = gfc_get_string (info->u.rsym.module);
 
-		  /* TODO: hmm, can we test this?  Do we know it will be
-		     initialized to zeros?  */
-		  if (info->u.rsym.binding_label[0] != '\0')
-		    strcpy (sym->binding_label, info->u.rsym.binding_label);
+		  if (info->u.rsym.binding_label)
+		    sym->binding_label = 
+		      IDENTIFIER_POINTER (get_identifier 
+					  (info->u.rsym.binding_label));
 		}
 
 	      st->n.sym = sym;
@@ -4836,10 +4871,10 @@ write_common_0 (gfc_symtree *st, bool this_module)
 
   write_common_0 (st->left, this_module);
 
-  /* We will write out the binding label, or the name if no label given.  */
+  /* We will write out the binding label, or "" if no label given.  */
   name = st->n.common->name;
   p = st->n.common;
-  label = p->is_bind_c ? p->binding_label : p->name;
+  label = (p->is_bind_c && p->binding_label) ? p->binding_label : "";
 
   /* Check if we've already output this common.  */
   w = written_commons;
@@ -4924,9 +4959,8 @@ write_blank_common (void)
   /* Write out whether the common block is bind(c) or not.  */
   mio_integer (&is_bind_c);
 
-  /* Write out the binding label, which is BLANK_COMMON_NAME, though
-     it doesn't matter because the label isn't used.  */
-  mio_pool_string (&name);
+  /* Write out an empty binding label.  */
+  mio_write_string ("");
 
   mio_rparen ();
 }
@@ -5024,13 +5058,13 @@ write_symbol (int n, gfc_symbol *sym)
     mio_pool_string (&sym->name);
 
   mio_pool_string (&sym->module);
-  if (sym->attr.is_bind_c || sym->attr.is_iso_c)
+  if ((sym->attr.is_bind_c || sym->attr.is_iso_c) && sym->binding_label)
     {
       label = sym->binding_label;
       mio_pool_string (&label);
     }
   else
-    mio_pool_string (&sym->name);
+    mio_write_string ("");
 
   mio_pointer_ref (&sym->ns);
 

gcc/fortran/resolve.c

@@ -2722,7 +2722,6 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
                           gfc_symbol **new_sym)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
   int optional_arg = 0;
   gfc_try retval = SUCCESS;
   gfc_symbol *args_sym;
@@ -2756,26 +2755,23 @@ gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
 	{
 	  /* two args.  */
 	  sprintf (name, "%s_2", sym->name);
-	  sprintf (binding_label, "%s_2", sym->binding_label);
 	  optional_arg = 1;
 	}
       else
 	{
 	  /* one arg.  */
 	  sprintf (name, "%s_1", sym->name);
-	  sprintf (binding_label, "%s_1", sym->binding_label);
 	  optional_arg = 0;
 	}
 
       /* Get a new symbol for the version of c_associated that
 	 will get called.  */
-      *new_sym = get_iso_c_sym (sym, name, binding_label, optional_arg);
+      *new_sym = get_iso_c_sym (sym, name, NULL, optional_arg);
     }
   else if (sym->intmod_sym_id == ISOCBINDING_LOC
 	   || sym->intmod_sym_id == ISOCBINDING_FUNLOC)
     {
       sprintf (name, "%s", sym->name);
-      sprintf (binding_label, "%s", sym->binding_label);
 
       /* Error check the call.  */
       if (args->next != NULL)
@@ -3360,7 +3356,7 @@ generic:
 
 static void
 set_name_and_label (gfc_code *c, gfc_symbol *sym,
-                    char *name, char *binding_label)
+                    char *name, char **binding_label)
 {
   gfc_expr *arg = NULL;
   char type;
@@ -3393,7 +3389,8 @@ set_name_and_label (gfc_code *c, gfc_symbol *sym,
       sprintf (name, "%s_%c%d", sym->name, type, kind);
       /* Set up the binding label as the given symbol's label plus
          the type and kind.  */
-      sprintf (binding_label, "%s_%c%d", sym->binding_label, type, kind);
+      *binding_label = gfc_get_string ("%s_%c%d", sym->binding_label, type, 
+				       kind);
     }
   else
     {
@@ -3401,7 +3398,7 @@ set_name_and_label (gfc_code *c, gfc_symbol *sym,
          was, cause it should at least be found, and the missing
          arg error will be caught by compare_parameters().  */
       sprintf (name, "%s", sym->name);
-      sprintf (binding_label, "%s", sym->binding_label);
+      *binding_label = sym->binding_label;
     }
    
   return;
@@ -3423,7 +3420,7 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
   gfc_symbol *new_sym;
   /* this is fine, since we know the names won't use the max */
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  char* binding_label;
   /* default to success; will override if find error */
   match m = MATCH_YES;
 
@@ -3434,7 +3431,7 @@ gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
   if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
       (sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
     {
-      set_name_and_label (c, sym, name, binding_label);
+      set_name_and_label (c, sym, name, &binding_label);
       
       if (sym->intmod_sym_id == ISOCBINDING_F_POINTER)
 	{
@@ -9668,6 +9665,8 @@ resolve_bind_c_comms (gfc_symtree *comm_block_tree)
     {
       gfc_gsymbol *binding_label_gsym;
       gfc_gsymbol *comm_name_gsym;
+      const char * bind_label = comm_block_tree->n.common->binding_label 
+	? comm_block_tree->n.common->binding_label : "";
 
       /* See if a global symbol exists by the common block's name.  It may
          be NULL if the common block is use-associated.  */
@@ -9676,7 +9675,7 @@ resolve_bind_c_comms (gfc_symtree *comm_block_tree)
       if (comm_name_gsym != NULL && comm_name_gsym->type != GSYM_COMMON)
         gfc_error ("Binding label '%s' for common block '%s' at %L collides "
                    "with the global entity '%s' at %L",
-                   comm_block_tree->n.common->binding_label,
+                   bind_label,
                    comm_block_tree->n.common->name,
                    &(comm_block_tree->n.common->where),
                    comm_name_gsym->name, &(comm_name_gsym->where));
@@ -9688,17 +9687,14 @@ resolve_bind_c_comms (gfc_symtree *comm_block_tree)
              as expected.  */
           if (comm_name_gsym->binding_label == NULL)
             /* No binding label for common block stored yet; save this one.  */
-            comm_name_gsym->binding_label =
-              comm_block_tree->n.common->binding_label;
-          else
-            if (strcmp (comm_name_gsym->binding_label,
-                        comm_block_tree->n.common->binding_label) != 0)
+            comm_name_gsym->binding_label = bind_label;
+          else if (strcmp (comm_name_gsym->binding_label, bind_label) != 0)
               {
                 /* Common block names match but binding labels do not.  */
                 gfc_error ("Binding label '%s' for common block '%s' at %L "
                            "does not match the binding label '%s' for common "
                            "block '%s' at %L",
-                           comm_block_tree->n.common->binding_label,
+                           bind_label,
                            comm_block_tree->n.common->name,
                            &(comm_block_tree->n.common->where),
                            comm_name_gsym->binding_label,
@@ -9710,7 +9706,7 @@ resolve_bind_c_comms (gfc_symtree *comm_block_tree)
 
       /* There is no binding label (NAME="") so we have nothing further to
          check and nothing to add as a global symbol for the label.  */
-      if (comm_block_tree->n.common->binding_label[0] == '\0' )
+      if (!comm_block_tree->n.common->binding_label)
         return;
       
       binding_label_gsym =
@@ -9777,7 +9773,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
   int has_error = 0;
   
   if (sym != NULL && sym->attr.is_bind_c && sym->attr.is_iso_c == 0 
-      && sym->attr.flavor != FL_DERIVED && sym->binding_label[0] != '\0')
+      && sym->attr.flavor != FL_DERIVED && sym->binding_label)
     {
       gfc_gsymbol *bind_c_sym;
 
@@ -9828,8 +9824,8 @@ gfc_verify_binding_labels (gfc_symbol *sym)
               }
 
           if (has_error != 0)
-            /* Clear the binding label to prevent checking multiple times.  */
-            sym->binding_label[0] = '\0';
+	    /* Clear the binding label to prevent checking multiple times.  */
+	    sym->binding_label = NULL;
         }
       else if (bind_c_sym == NULL)
 	{

gcc/fortran/symbol.c

 /* Maintain binary trees of symbols.
    Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-   2009, 2010, 2011
+   2009, 2010, 2011, 2012
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -2556,8 +2556,6 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
   /* Make sure flags for symbol being C bound are clear initially.  */
   p->attr.is_bind_c = 0;
   p->attr.is_iso_c = 0;
-  /* Make sure the binding label field has a Nul char to start.  */
-  p->binding_label[0] = '\0';
 
   /* Clear the ptrs we may need.  */
   p->common_block = NULL;
@@ -3805,8 +3803,8 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   
   tmp_sym->attr.use_assoc = 1;
   tmp_sym->attr.is_bind_c = 1;
-  /* Set the binding_label.  */
-  sprintf (tmp_sym->binding_label, "%s_%s", module_name, tmp_sym->name);
+  /* Since we never generate a call to this symbol, don't set the
+     binding_label.  */
   
   /* Set the c_address field of c_null_ptr and c_null_funptr to
      the value of NULL.	 */
@@ -4588,8 +4586,9 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 
         /* Use the procedure's name as it is in the iso_c_binding module for
            setting the binding label in case the user renamed the symbol.  */
-	sprintf (tmp_sym->binding_label, "%s_%s", mod_name,
-                 c_interop_kinds_table[s].name);
+	tmp_sym->binding_label = 
+	  gfc_get_string ("%s_%s", mod_name, 
+			  c_interop_kinds_table[s].name);
 	tmp_sym->attr.is_iso_c = 1;
 	if (s == ISOCBINDING_F_POINTER || s == ISOCBINDING_F_PROCPOINTER)
 	  tmp_sym->attr.subroutine = 1;
@@ -4702,7 +4701,7 @@ get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
 			"symtree for '%s'", new_name);
 
   /* Now fill in the fields of the resolved symbol with the old sym.  */
-  strcpy (new_symtree->n.sym->binding_label, new_binding_label);
+  new_symtree->n.sym->binding_label = new_binding_label;
   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);

gcc/fortran/trans-common.c

@@ -244,7 +244,7 @@ gfc_sym_mangled_common_id (gfc_common_head *com)
   strcpy (name, com->name);
 
   /* If we're suppose to do a bind(c).  */
-  if (com->is_bind_c == 1 && com->binding_label[0] != '\0')
+  if (com->is_bind_c == 1 && com->binding_label)
     return get_identifier (com->binding_label);
 
   if (strcmp (name, BLANK_COMMON_NAME) == 0)

gcc/fortran/trans-decl.c

@@ -326,9 +326,8 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
 
   /* Prevent the mangling of identifiers that have an assigned
      binding label (mainly those that are bind(c)).  */
-  if (sym->attr.is_bind_c == 1
-      && sym->binding_label[0] != '\0')
-    return get_identifier(sym->binding_label);
+  if (sym->attr.is_bind_c == 1 && sym->binding_label)
+    return get_identifier (sym->binding_label);
   
   if (sym->module == NULL)
     return gfc_sym_identifier (sym);
@@ -352,7 +351,7 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
      provided, and remove the other checks.  Then we could use it
      for other things if we wished.  */
   if ((sym->attr.is_bind_c == 1 || sym->attr.is_iso_c == 1) &&
-      sym->binding_label[0] != '\0')
+      sym->binding_label)
     /* use the binding label rather than the mangled name */
     return get_identifier (sym->binding_label);
 

gcc/testsuite/ChangeLog

+2012-01-29  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/51808
+	* gfortran.dg/module_md5_1.f90: Update MD5 sum.
+
 2012-01-28  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51972

gcc/testsuite/gfortran.dg/module_md5_1.f90

@@ -10,5 +10,5 @@ program test
   use foo
   print *, pi
 end program test
-! { dg-final { scan-module "foo" "MD5:12a205c48fe46315a609823f15986377" } }
+! { dg-final { scan-module "foo" "MD5:510304affe70481794fecdb22fc9ca0c" } }
 ! { dg-final { cleanup-modules "foo" } }