This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR 51808 Heap allocate binding labels
- From: Janne Blomqvist <blomqvist dot janne at gmail dot com>
- To: Mikael Morin <mikael dot morin at sfr dot fr>
- Cc: Tobias Burnus <tobias dot burnus at physik dot fu-berlin dot de>, gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Sun, 29 Jan 2012 19:21:48 +0200
- Subject: Re: [Patch, fortran] PR 51808 Heap allocate binding labels
- References: <20120118091237.GA14022@physik.fu-berlin.de> <4F16BEDA.9050505@sfr.fr>
On Wed, Jan 18, 2012 at 14:45, Mikael Morin <mikael.morin@sfr.fr> wrote:
> On 18.01.2012 10:12, Tobias Burnus wrote:
>>
>>
>> Dear Janne,
>>
>>> the attached patch changes the binding labels that are needed for
>>> bind(C) symbols to be heap allocated rather than, as currently, being
>>> fixed size arrays of size 127 (or 64 in module.c!?).
>>
>>
>> Âwonder whether it would have been smarter to use string matching rather
>> than the manual matching in gfc_match_name_C to obtain longer strings.
>> (Cf. PR 36275. Different but related binding label issue: PR 38839.)
>> On the other hand, that's separate issues, deserving patches on their own.
>>
>>
>>> --- a/gcc/fortran/resolve.c
>>> +++ b/gcc/fortran/resolve.c
>>> @@ -2744,14 +2747,16 @@ gfc_iso_c_func_interface (gfc_symbol *sym,
>>> Â Â Â Â{
>>> Â Â Â Â Â/* two args. Â*/
>>> Â Â Â Â Âsprintf (name, "%s_2", sym->name);
>>> - Â Â Â Â sprintf (binding_label, "%s_2", sym->binding_label);
>>> + Â Â Â Â if (sym->binding_label)
>>> + Â Â Â Â Â sprintf (binding_label, "%s_2", sym->binding_label);
>>> Â Â Â Â Âoptional_arg = 1;
>>
>>
>> I wonder whether one can get rid of all those binding names. I think
>> they date back to the time when a libgfortran function was called for
>> ISOCBINDING_ASSOCIATED instead of just generating in trans-intrinsics.c
>> one (ptr != NULL) or two (ptr != NULL&& Âptr == tgt) pointer comparisons.
>>
>> I also believe that C_LOC and C_FUNLOC are (now) handled in
>> trans-intrinsics.c. Thus, you could confirm that no binding name is
>> needed and remove them.
>>
>>
>> Otherwise, the patch looks relatively mechnical and is OK.
>>
>> Tobias
>
>
> Hello,
>
> We could consider using gfc_get_string (instead of the many strcpy) to ease
> memory management.
Taking into account the suggestions by Tobias and Mikael, attached is
the patch I just committed. Thanks for the reviews!
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.
--
Janne Blomqvist
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7f3fad2..0cfb0ef 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
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 23c16ba..bf9a1f9 100644
--- a/gcc/fortran/gfortran.h
+++ b/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;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 0585308..3024cc7 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1,6 +1,6 @@
/* 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. */
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index c4e7e91..642c437 100644
--- a/gcc/fortran/match.h
+++ b/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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index b2808d4..4e6c520 100644
--- a/gcc/fortran/module.c
+++ b/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);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2a96712..cdc4231 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2732,7 +2732,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;
@@ -2766,26 +2765,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)
@@ -3370,7 +3366,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;
@@ -3403,7 +3399,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
{
@@ -3411,7 +3408,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;
@@ -3433,7 +3430,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;
@@ -3444,7 +3441,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)
{
@@ -9678,6 +9675,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. */
@@ -9686,7 +9685,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));
@@ -9698,17 +9697,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,
@@ -9720,7 +9716,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 =
@@ -9787,7 +9783,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;
@@ -9838,8 +9834,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)
{
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 36fc1ed..e13e1df 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1,6 +1,6 @@
/* 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);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 22aa350..dcc2176 100644
--- a/gcc/fortran/trans-common.c
+++ b/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)
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 8efe5a9..cb8f613 100644
--- a/gcc/fortran/trans-decl.c
+++ b/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);
diff --git a/gcc/testsuite/gfortran.dg/module_md5_1.f90 b/gcc/testsuite/gfortran.dg/module_md5_1.f90
index f146cd2..0816a70 100644
--- a/gcc/testsuite/gfortran.dg/module_md5_1.f90
+++ b/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" } }
diff --git a/libgcc/configure b/libgcc/configure
old mode 100644
new mode 100755