+/* Show the f2k_derived namespace with procedure bindings. */
+
+static void
+show_typebound_proc (gfc_typebound_proc* tb, const char* name)
+{
+ show_indent ();
+
+ if (tb->is_generic)
+ fputs ("GENERIC", dumpfile);
+ else
+ {
+ fputs ("PROCEDURE, ", dumpfile);
+ if (tb->nopass)
+ fputs ("NOPASS", dumpfile);
+ else
+ {
+ if (tb->pass_arg)
+ fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
+ else
+ fputs ("PASS", dumpfile);
+ }
+ if (tb->non_overridable)
+ fputs (", NON_OVERRIDABLE", dumpfile);
+ }
+
+ if (tb->access == ACCESS_PUBLIC)
+ fputs (", PUBLIC", dumpfile);
+ else
+ fputs (", PRIVATE", dumpfile);
+
+ fprintf (dumpfile, " :: %s => ", name);
+
+ if (tb->is_generic)
+ {
+ gfc_tbp_generic* g;
+ for (g = tb->u.generic; g; g = g->next)
+ {
+ fputs (g->specific_st->name, dumpfile);
+ if (g->next)
+ fputs (", ", dumpfile);
+ }
+ }
+ else
+ fputs (tb->u.specific->n.sym->name, dumpfile);
+}
+
+static void
+show_typebound_symtree (gfc_symtree* st)
+{
+ gcc_assert (st->n.tb);
+ show_typebound_proc (st->n.tb, st->name);
+}
+
+static void
+show_f2k_derived (gfc_namespace* f2k)
+{
+ gfc_finalizer* f;
+ int op;
+
+ show_indent ();
+ fputs ("Procedure bindings:", dumpfile);
+ ++show_level;
+
+ /* Finalizer bindings. */
+ for (f = f2k->finalizers; f; f = f->next)
+ {
+ show_indent ();
+ fprintf (dumpfile, "FINAL %s", f->proc_sym->name);
+ }
+
+ /* Type-bound procedures. */
+ gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
+
+ --show_level;
+
+ show_indent ();
+ fputs ("Operator bindings:", dumpfile);
+ ++show_level;
+
+ /* User-defined operators. */
+ gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
+
+ /* Intrinsic operators. */
+ for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
+ if (f2k->tb_op[op])
+ show_typebound_proc (f2k->tb_op[op],
+ gfc_op2string ((gfc_intrinsic_op) op));
+
+ --show_level;
+}
+
+