re PR fortran/37425 (Fortran 2003: GENERIC bindings as operators)

2009-08-30  Daniel Kraft  <d@domob.eu>

	PR fortran/37425
	* dump-parse-tree.c (show_typebound_proc): Renamed from `show_typebound'
	and accept gfc_typebound_proc and name instead of the symtree, needed
	for intrinsic operator output.
	(show_typebound_symtree): New method calling `show_typebound_proc'.
	(show_f2k_derived): Output type-bound operators also.
	(show_symbol): Moved output of `Procedure bindings:' label to
	`show_f2k_derived'.
	* gfortran.texi (Fortran 2003 status): Mention support of
	array-constructors with explicit type specification, type-bound
	procedures/operators, type extension, ABSTRACT types and DEFERRED.
	Link to Fortran 2003 wiki page.
	(Fortran 2008 status): Fix typo.  Link to Fortran 2008 wiki page.
	* gfc-internals.texi (Type-bound Procedures): Document the new
	members/attributes of gfc_expr.value.compcall used for type-bound
	operators.
	(Type-bound Operators): New section documenting their internals.

From-SVN: r151224

1 files changed, 38 insertions, 18 deletions

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 5802cdc..8480e40 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -680,40 +680,39 @@ show_components (gfc_symbol *sym)
 /* Show the f2k_derived namespace with procedure bindings.  */
 
 static void
-show_typebound (gfc_symtree* st)
+show_typebound_proc (gfc_typebound_proc* tb, const char* name)
 {
-  gcc_assert (st->n.tb);
   show_indent ();
 
-  if (st->n.tb->is_generic)
+  if (tb->is_generic)
     fputs ("GENERIC", dumpfile);
   else
     {
       fputs ("PROCEDURE, ", dumpfile);
-      if (st->n.tb->nopass)
+      if (tb->nopass)
 	fputs ("NOPASS", dumpfile);
       else
 	{
-	  if (st->n.tb->pass_arg)
-	    fprintf (dumpfile, "PASS(%s)", st->n.tb->pass_arg);
+	  if (tb->pass_arg)
+	    fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
 	  else
 	    fputs ("PASS", dumpfile);
 	}
-      if (st->n.tb->non_overridable)
+      if (tb->non_overridable)
 	fputs (", NON_OVERRIDABLE", dumpfile);
     }
 
-  if (st->n.tb->access == ACCESS_PUBLIC)
+  if (tb->access == ACCESS_PUBLIC)
     fputs (", PUBLIC", dumpfile);
   else
     fputs (", PRIVATE", dumpfile);
 
-  fprintf (dumpfile, " :: %s => ", st->name);
+  fprintf (dumpfile, " :: %s => ", name);
 
-  if (st->n.tb->is_generic)
+  if (tb->is_generic)
     {
       gfc_tbp_generic* g;
-      for (g = st->n.tb->u.generic; g; g = g->next)
+      for (g = tb->u.generic; g; g = g->next)
 	{
 	  fputs (g->specific_st->name, dumpfile);
 	  if (g->next)
@@ -721,14 +720,24 @@ show_typebound (gfc_symtree* st)
 	}
     }
   else
-    fputs (st->n.tb->u.specific->n.sym->name, dumpfile);
+    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.  */
@@ -739,7 +748,22 @@ show_f2k_derived (gfc_namespace* f2k)
     }
 
   /* Type-bound procedures.  */
-  gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound);
+  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;
 }
@@ -801,11 +825,7 @@ show_symbol (gfc_symbol *sym)
     }
 
   if (sym->f2k_derived)
-    {
-      show_indent ();
-      fputs ("Procedure bindings:\n", dumpfile);
-      show_f2k_derived (sym->f2k_derived);
-    }
+    show_f2k_derived (sym->f2k_derived);
 
   if (sym->formal)
     {