+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
* 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
#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. */
#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. */
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;
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;
}
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)
{
(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)
{
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;
/* 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 "
/* 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;
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;
/* 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);
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;
}
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;
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)
/* 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. */
/* 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)
{
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
/* 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. */
/* 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;
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;
/* 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
#include "gfortran.h"
#include "match.h"
#include "parse.h"
+#include "tree.h"
int gfc_matching_ptr_assignment = 0;
int gfc_matching_procptr_assignment = 0;
/* 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 ();
symbol name, all lowercase. */
if (c == '"' || c == '\'')
{
- buffer[0] = '\0';
gfc_current_locus = old_loc;
return MATCH_YES;
}
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;
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. */
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 *);
/* 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);
#include "md5.h"
#include "constructor.h"
#include "cpp.h"
+#include "tree.h"
#define MODULE_EXTENSION ".mod"
module_locus where;
fixup_t *stfixup;
gfc_symtree *symtree;
- char binding_label[GFC_MAX_SYMBOL_LEN + 1];
+ char* binding_label;
}
rsym;
free_pi_tree (p->left);
free_pi_tree (p->right);
+ if (iomode == IO_INPUT)
+ XDELETEVEC (p->u.rsym.binding_label);
+
free (p);
}
}
+/* 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,
while (peek_atom () != ATOM_RPAREN)
{
int flags;
+ char* label;
mio_lparen ();
mio_internal_string (name);
/* 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 ();
}
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);
}
while (peek_atom () != ATOM_RPAREN)
{
+ char* bind_label;
require_atom (ATOM_INTEGER);
info = get_integer (atom_int);
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;
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;
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;
/* 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 ();
}
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);
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;
{
/* 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)
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;
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
{
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;
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;
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)
{
{
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. */
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));
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,
/* 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 =
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;
}
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)
{
/* 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
/* 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;
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. */
/* 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;
"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);
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)
/* 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);
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);
+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
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" } }
projects / platform / upstream / gcc.git / commitdiff