* arith.c: Update copyright years.

[pf3gnuchains/gcc-fork.git] / gcc / fortran / symbol.c

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ae97a65..c86fa9a 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1,5 +1,5 @@
 /* Maintain binary trees of symbols.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -2153,8 +2153,8 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
 
 /* Delete a symbol from the tree.  Does not free the symbol itself!  */
 
-static void
-delete_symtree (gfc_symtree **root, const char *name)
+void
+gfc_delete_symtree (gfc_symtree **root, const char *name)
 {
   gfc_symtree st, *st0;
 
@@ -2582,7 +2582,34 @@ gfc_undo_symbols (void)
       if (p->new)
        {
          /* Symbol was new.  */
-         delete_symtree (&p->ns->sym_root, p->name);
+         if (p->attr.in_common && p->common_block->head)
+           {
+             /* If the symbol was added to any common block, it
+                needs to be removed to stop the resolver looking
+                for a (possibly) dead symbol.  */
+
+             if (p->common_block->head == p)
+               p->common_block->head = p->common_next;
+             else
+               {
+                 gfc_symbol *cparent, *csym;
+
+                 cparent = p->common_block->head;
+                 csym = cparent->common_next;
+
+                 while (csym != p)
+                   {
+                     cparent = csym;
+                     csym = csym->common_next;
+                   }
+
+                 gcc_assert(cparent->common_next == p);
+
+                 cparent->common_next = csym->common_next;
+               }
+           }
+
+         gfc_delete_symtree (&p->ns->sym_root, p->name);
 
          p->refs--;
          if (p->refs < 0)
@@ -2927,13 +2954,12 @@ clear_sym_mark (gfc_symtree *st)
 void
 gfc_traverse_symtree (gfc_symtree *st, void (*func) (gfc_symtree *))
 {
-  if (st != NULL)
-    {
-      (*func) (st);
+  if (!st)
+    return;
 
-      gfc_traverse_symtree (st->left, func);
-      gfc_traverse_symtree (st->right, func);
-    }
+  gfc_traverse_symtree (st->left, func);
+  (*func) (st);
+  gfc_traverse_symtree (st->right, func);
 }
 
 
@@ -2946,11 +2972,12 @@ traverse_ns (gfc_symtree *st, void (*func) (gfc_symbol *))
   if (st == NULL)
     return;
 
+  traverse_ns (st->left, func);
+
   if (st->n.sym->mark == 0)
     (*func) (st->n.sym);
   st->n.sym->mark = 1;
 
-  traverse_ns (st->left, func);
   traverse_ns (st->right, func);
 }
 
@@ -3354,10 +3381,10 @@ gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
   tmp_sym->value->expr_type = EXPR_STRUCTURE;
   tmp_sym->value->ts.type = BT_DERIVED;
   tmp_sym->value->ts.derived = tmp_sym->ts.derived;
+  /* Create a constructor with no expr, that way we can recognize if the user
+     tries to call the structure constructor for one of the iso_c_binding
+     derived types during resolution (resolve_structure_cons).  */
   tmp_sym->value->value.constructor = gfc_get_constructor ();
-  /* This line will initialize the c_null_ptr/c_null_funptr
-     c_address field to NULL.  */
-  tmp_sym->value->value.constructor->expr = gfc_int_expr (0);
   /* Must declare c_null_ptr and c_null_funptr as having the
      PARAMETER attribute so they can be used in init expressions.  */
   tmp_sym->attr.flavor = FL_PARAMETER;
@@ -3810,6 +3837,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
        tmp_sym->value->value.character.string[0]
          = (char) c_interop_kinds_table[s].value;
        tmp_sym->value->value.character.string[1] = '\0';
+       tmp_sym->ts.cl = gfc_get_charlen ();
+       tmp_sym->ts.cl->length = gfc_int_expr (1);
 
        /* May not need this in both attr and ts, but do need in
           attr for writing module file.  */