2008-01-17 H.J. Lu <hongjiu.lu@intel.com>

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

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index d6bd963..a50ed26 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2726,14 +2726,14 @@ gfc_commit_symbol (gfc_symbol *sym)
 /* Recursive function that deletes an entire tree and all the common
    head structures it points to.  */
 
-static void
-free_common_tree (gfc_symtree * common_tree)
+void
+gfc_free_common_tree (gfc_symtree * common_tree)
 {
   if (common_tree == NULL)
     return;
 
-  free_common_tree (common_tree->left);
-  free_common_tree (common_tree->right);
+  gfc_free_common_tree (common_tree->left);
+  gfc_free_common_tree (common_tree->right);
 
   gfc_free (common_tree);
 }  
@@ -2863,7 +2863,7 @@ gfc_free_namespace (gfc_namespace *ns)
 
   free_sym_tree (ns->sym_root);
   free_uop_tree (ns->uop_root);
-  free_common_tree (ns->common_root);
+  gfc_free_common_tree (ns->common_root);
 
   for (cl = ns->cl_list; cl; cl = cl2)
     {
@@ -2927,13 +2927,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 +2945,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 +3354,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 +3810,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.  */
@@ -4029,6 +4031,8 @@ get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
   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);
+  new_symtree->n.sym->from_intmod = old_sym->from_intmod;
+  new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id;
   /* Build the formal arg list.  */
   build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);