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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183677 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 27 insertions, 29 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7f3fad2fe0a..0cfb0ef3831 100644
--- a/gcc/fortran/decl.c
+++ b/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