Patchwork [Fortran,OOP] PR 46448: [4.6 Regression] symbol `__copy_...' is already defined

login
register
mail settings
Submitter Janus Weil
Date Jan. 3, 2011, 4:12 p.m.
Message ID <AANLkTikS7=NwycCnWQm8G70r2Q6n6-3uSa3Fo4UH0mve@mail.gmail.com>
Download mbox | patch
Permalink /patch/77291/
State New
Headers show

Comments

Janus Weil - Jan. 3, 2011, 4:12 p.m.
Hi all,

here is a patch to fix a recent OOP regression. It avoids duplication
of the '__copy_...' routines (which are used for polymorphic
allocation with source) by adding global symbols for those routines.

The patch also introduces a new function called 'gfc_add_gsymbol',
which is used to add symbols to gfortran's list of global symbols
(gfc_gsym_root). It replaces various other functions like
'add_global_entry', 'add_global_procedure' and 'add_global_program',
which all did basically the same thing. The new function also includes
an 'ns' argument. This is needed for the __copy_ routines, since these
do go into the gfc_current_ns namespace.

The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2011-01-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46448
	* gfortran.h (gfc_add_gsymbol): New prototype.
	* class.c (gfc_find_derived_vtab): Add a global symbol for the copying
	routine to avoid duplication.
	* decl.c (add_global_entry): Removed.
	(gfc_match_entry): Use 'gfc_add_gsymbol' instead of 'add_global_entry'.
	* parse.c (add_global_procedure,add_global_program): Removed.
	(parse_block_data,parse_module,gfc_parse_file): Use 'gfc_add_gsymbol'.
	* symbol.c (gfc_add_gsymbol): New function for adding global symbols,
	replacing 'add_global_entry', 'add_global_procedure' and
	'add_global_program'.


2011-01-03  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46448
	* gfortran.dg/class_34.f90: New.

Patch

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 168424)
+++ gcc/fortran/symbol.c	(working copy)
@@ -3543,6 +3543,30 @@  gfc_get_gsymbol (const char *name)
 }
 
 
+/* Add a procedure name to the global symbol table.
+   Returns false upon finding an existing global entry.  */
+
+bool
+gfc_add_gsymbol (const char *name, gfc_namespace *ns, enum gfc_symbol_type type)
+{
+  gfc_gsymbol *s;
+
+  s = gfc_get_gsymbol(name);
+
+  if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
+    gfc_global_used (s, NULL);
+  else
+    {
+      s->type = type;
+      s->where = gfc_current_locus;
+      s->defined = 1;
+      s->ns = ns ? ns : gfc_current_ns;
+      return true;
+    }
+  return false;
+}
+
+
 static gfc_symbol *
 get_iso_c_binding_dt (int sym_id)
 {
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 168424)
+++ gcc/fortran/class.c	(working copy)
@@ -517,40 +517,52 @@  gfc_find_derived_vtab (gfc_symbol *derived)
 		c->initializer = gfc_get_null_expr (NULL);
 	      else
 		{
-		  /* Set up namespace.  */
-		  gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
-		  sub_ns->sibling = ns->contained;
-		  ns->contained = sub_ns;
-		  sub_ns->resolved = 1;
-		  /* Set up procedure symbol.  */
+		  gfc_gsymbol *gsym;
 		  sprintf (name, "__copy_%s", tname);
-		  gfc_get_symbol (name, sub_ns, &copy);
-		  sub_ns->proc_name = copy;
-		  copy->attr.flavor = FL_PROCEDURE;
-		  copy->attr.if_source = IFSRC_DECL;
-		  gfc_set_sym_referenced (copy);
-		  /* Set up formal arguments.  */
-		  gfc_get_symbol ("src", sub_ns, &src);
-		  src->ts.type = BT_DERIVED;
-		  src->ts.u.derived = derived;
-		  src->attr.flavor = FL_VARIABLE;
-		  src->attr.dummy = 1;
-		  gfc_set_sym_referenced (src);
-		  copy->formal = gfc_get_formal_arglist ();
-		  copy->formal->sym = src;
-		  gfc_get_symbol ("dst", sub_ns, &dst);
-		  dst->ts.type = BT_DERIVED;
-		  dst->ts.u.derived = derived;
-		  dst->attr.flavor = FL_VARIABLE;
-		  dst->attr.dummy = 1;
-		  gfc_set_sym_referenced (dst);
-		  copy->formal->next = gfc_get_formal_arglist ();
-		  copy->formal->next->sym = dst;
-		  /* Set up code.  */
-		  sub_ns->code = gfc_get_code ();
-		  sub_ns->code->op = EXEC_INIT_ASSIGN;
-		  sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
-		  sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
+		  gsym = gfc_find_gsymbol (gfc_gsym_root, name);
+		  if (gsym)
+		    {
+		      /* Global symbol already present.  */
+		      gfc_find_symbol (name, gsym->ns, 0, &copy);
+		      gcc_assert (copy);
+		    }
+		  else
+		    {
+		      /* Set up namespace.  */
+		      gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
+		      sub_ns->sibling = ns->contained;
+		      ns->contained = sub_ns;
+		      sub_ns->resolved = 1;
+		      /* Set up procedure symbol.  */
+		      gfc_get_symbol (name, sub_ns, &copy);
+		      sub_ns->proc_name = copy;
+		      copy->attr.flavor = FL_PROCEDURE;
+		      copy->attr.if_source = IFSRC_DECL;
+		      gfc_set_sym_referenced (copy);
+		      gfc_add_gsymbol (name, sub_ns, GSYM_SUBROUTINE);
+		      /* Set up formal arguments.  */
+		      gfc_get_symbol ("src", sub_ns, &src);
+		      src->ts.type = BT_DERIVED;
+		      src->ts.u.derived = derived;
+		      src->attr.flavor = FL_VARIABLE;
+		      src->attr.dummy = 1;
+		      gfc_set_sym_referenced (src);
+		      copy->formal = gfc_get_formal_arglist ();
+		      copy->formal->sym = src;
+		      gfc_get_symbol ("dst", sub_ns, &dst);
+		      dst->ts.type = BT_DERIVED;
+		      dst->ts.u.derived = derived;
+		      dst->attr.flavor = FL_VARIABLE;
+		      dst->attr.dummy = 1;
+		      gfc_set_sym_referenced (dst);
+		      copy->formal->next = gfc_get_formal_arglist ();
+		      copy->formal->next->sym = dst;
+		      /* Set up code.  */
+		      sub_ns->code = gfc_get_code ();
+		      sub_ns->code->op = EXEC_INIT_ASSIGN;
+		      sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
+		      sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
+		    }
 		  /* Set initializer.  */
 		  c->initializer = gfc_lval_expr_from_sym (copy);
 		  c->ts.interface = copy;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 168424)
+++ gcc/fortran/decl.c	(working copy)
@@ -5124,35 +5124,6 @@  cleanup:
 }
 
 
-/* This is mostly a copy of parse.c(add_global_procedure) but modified to
-   pass the name of the entry, rather than the gfc_current_block name, and
-   to return false upon finding an existing global entry.  */
-
-static bool
-add_global_entry (const char *name, int sub)
-{
-  gfc_gsymbol *s;
-  enum gfc_symbol_type type;
-
-  s = gfc_get_gsymbol(name);
-  type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
-
-  if (s->defined
-      || (s->type != GSYM_UNKNOWN
-	  && s->type != type))
-    gfc_global_used(s, NULL);
-  else
-    {
-      s->type = type;
-      s->where = gfc_current_locus;
-      s->defined = 1;
-      s->ns = gfc_current_ns;
-      return true;
-    }
-  return false;
-}
-
-
 /* Match an ENTRY statement.  */
 
 match
@@ -5278,7 +5249,8 @@  gfc_match_entry (void)
   if (state == COMP_SUBROUTINE)
     {
       /* An entry in a subroutine.  */
-      if (!gfc_current_ns->parent && !add_global_entry (name, 1))
+      if (!gfc_current_ns->parent
+	  && !gfc_add_gsymbol (name, NULL, GSYM_SUBROUTINE))
 	return MATCH_ERROR;
 
       m = gfc_match_formal_arglist (entry, 0, 1);
@@ -5317,7 +5289,8 @@  gfc_match_entry (void)
 	    ENTRY f() RESULT (r)
 	 can't be written as
 	    ENTRY f RESULT (r).  */
-      if (!gfc_current_ns->parent && !add_global_entry (name, 0))
+      if (!gfc_current_ns->parent
+	  && !gfc_add_gsymbol (name, NULL, GSYM_FUNCTION))
 	return MATCH_ERROR;
 
       old_loc = gfc_current_locus;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 168424)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2583,9 +2583,9 @@  void gfc_save_all (gfc_namespace *);
 void gfc_enforce_clean_symbol_state (void);
 void gfc_free_dt_list (void);
 
-
+gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
 gfc_gsymbol *gfc_get_gsymbol (const char *);
-gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
+bool gfc_add_gsymbol (const char *, gfc_namespace *, enum gfc_symbol_type);
 
 gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
 gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 168424)
+++ gcc/fortran/parse.c	(working copy)
@@ -4053,7 +4053,6 @@  parse_block_data (void)
   gfc_statement st;
   static locus blank_locus;
   static int blank_block=0;
-  gfc_gsymbol *s;
 
   gfc_current_ns->proc_name = gfc_new_block;
   gfc_current_ns->is_block_data = 1;
@@ -4070,18 +4069,7 @@  parse_block_data (void)
        }
     }
   else
-    {
-      s = gfc_get_gsymbol (gfc_new_block->name);
-      if (s->defined
-	  || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
-       gfc_global_used(s, NULL);
-      else
-       {
-	 s->type = GSYM_BLOCK_DATA;
-	 s->where = gfc_current_locus;
-	 s->defined = 1;
-       }
-    }
+    gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_BLOCK_DATA);
 
   st = parse_spec (ST_NONE);
 
@@ -4101,17 +4089,8 @@  static void
 parse_module (void)
 {
   gfc_statement st;
-  gfc_gsymbol *s;
 
-  s = gfc_get_gsymbol (gfc_new_block->name);
-  if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
-    gfc_global_used(s, NULL);
-  else
-    {
-      s->type = GSYM_MODULE;
-      s->where = gfc_current_locus;
-      s->defined = 1;
-    }
+  gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_MODULE);
 
   st = parse_spec (ST_NONE);
 
@@ -4137,57 +4116,9 @@  loop:
       st = next_statement ();
       goto loop;
     }
-
-  s->ns = gfc_current_ns;
 }
 
 
-/* Add a procedure name to the global symbol table.  */
-
-static void
-add_global_procedure (int sub)
-{
-  gfc_gsymbol *s;
-
-  s = gfc_get_gsymbol(gfc_new_block->name);
-
-  if (s->defined
-      || (s->type != GSYM_UNKNOWN
-	  && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
-    gfc_global_used(s, NULL);
-  else
-    {
-      s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
-      s->where = gfc_current_locus;
-      s->defined = 1;
-      s->ns = gfc_current_ns;
-    }
-}
-
-
-/* Add a program to the global symbol table.  */
-
-static void
-add_global_program (void)
-{
-  gfc_gsymbol *s;
-
-  if (gfc_new_block == NULL)
-    return;
-  s = gfc_get_gsymbol (gfc_new_block->name);
-
-  if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
-    gfc_global_used(s, NULL);
-  else
-    {
-      s->type = GSYM_PROGRAM;
-      s->where = gfc_current_locus;
-      s->defined = 1;
-      s->ns = gfc_current_ns;
-    }
-}
-
-
 /* Resolve all the program units when whole file scope option
    is active. */
 static void
@@ -4314,14 +4245,15 @@  loop:
       push_state (&s, COMP_PROGRAM, gfc_new_block);
       main_program_symbol(gfc_current_ns, gfc_new_block->name);
       accept_statement (st);
-      add_global_program ();
+      if (gfc_new_block)
+	gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_PROGRAM);
       parse_progunit (ST_NONE);
       if (gfc_option.flag_whole_file)
 	goto prog_units;
       break;
 
     case ST_SUBROUTINE:
-      add_global_procedure (1);
+      gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_SUBROUTINE);
       push_state (&s, COMP_SUBROUTINE, gfc_new_block);
       accept_statement (st);
       parse_progunit (ST_NONE);
@@ -4330,7 +4262,7 @@  loop:
       break;
 
     case ST_FUNCTION:
-      add_global_procedure (0);
+      gfc_add_gsymbol (gfc_new_block->name, NULL, GSYM_FUNCTION);
       push_state (&s, COMP_FUNCTION, gfc_new_block);
       accept_statement (st);
       parse_progunit (ST_NONE);