Patchwork [2/9] Define and export Guile classes for all GDB object types

login
register
mail settings
Submitter Andy Wingo
Date April 9, 2014, 4:08 p.m.
Message ID <1397059725-18066-3-git-send-email-wingo@igalia.com>
Download mbox | patch
Permalink /patch/441/
State Changes Requested
Headers show

Comments

Andy Wingo - April 9, 2014, 4:08 p.m.
* gdb/guile/scm-gsmob.c (gdbscm_make_smob_type): Define a binding for a
  GOOPS class corresponding to the SMOB type.  In Guile 2.0, this
  binding is also exported by (oop goops), but this is no longer the
  case in Guile 2.2, so we take care of doing that here.
  (gdbscm_initialize_smobs): Load GOOPS, so that we can ensure the
  classes actually get created.

* gdb/guile/lib/gdb.scm: Export the GOOPS classes.

* gdb/testsuite/gdb.guile/scm-generics.exp: Import (gdb) in the test so
  that we have access to the <gdb:value> type in Guile 2.2.
---
 gdb/guile/lib/gdb.scm                    | 18 ++++++++++++++++++
 gdb/guile/scm-gsmob.c                    | 14 +++++++++++++-
 gdb/testsuite/gdb.guile/scm-generics.exp |  2 +-
 3 files changed, 32 insertions(+), 2 deletions(-)

Patch

diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
index f12769e..37f0934 100644
--- a/gdb/guile/lib/gdb.scm
+++ b/gdb/guile/lib/gdb.scm
@@ -278,6 +278,24 @@ 
  gsmob-has-property?
  gsmob-properties
 
+ <gdb:value>
+ <gdb:block>
+ <gdb:iterator>
+ <gdb:pretty-printer-worker>
+ <gdb:pretty-printer>
+ <gdb:sal>
+ <gdb:symtab>
+ <gdb:frame>
+ <gdb:block-symbols-iterator>
+ <gdb:field>
+ <gdb:type>
+ <gdb:arch>
+ <gdb:exception>
+ <gdb:objfile>
+ <gdb:lazy-string>
+ <gdb:breakpoint>
+ <gdb:symbol>
+
  ;; scm-string.c
 
  string->argv
diff --git a/gdb/guile/scm-gsmob.c b/gdb/guile/scm-gsmob.c
index b0f9e19..4c88ff9 100644
--- a/gdb/guile/scm-gsmob.c
+++ b/gdb/guile/scm-gsmob.c
@@ -120,7 +120,17 @@  gdbscm_is_gsmob (SCM scm)
 scm_t_bits
 gdbscm_make_smob_type (const char *name, size_t size)
 {
-  scm_t_bits result = scm_make_smob_type (name, size);
+  scm_t_bits result;
+  SCM klass;
+  char *class_name;
+
+  result = scm_make_smob_type (name, size);
+
+  klass = scm_smob_class[SCM_TC2SMOBNUM (result)];
+  gdb_assert (SCM_UNPACK (klass) != 0);
+  class_name = xstrprintf ("<%s>", name);
+  scm_c_define (class_name, klass);
+  xfree (class_name);
 
   register_gsmob (result);
   return result;
@@ -475,6 +485,8 @@  Return an unsorted list of names of properties." },
 void
 gdbscm_initialize_smobs (void)
 {
+  scm_c_use_module ("oop goops");
+
   registered_gsmobs = htab_create_alloc (10,
 					 hash_scm_t_bits, eq_scm_t_bits,
 					 NULL, xcalloc, xfree);
diff --git a/gdb/testsuite/gdb.guile/scm-generics.exp b/gdb/testsuite/gdb.guile/scm-generics.exp
index 664affc..93ab0e5 100644
--- a/gdb/testsuite/gdb.guile/scm-generics.exp
+++ b/gdb/testsuite/gdb.guile/scm-generics.exp
@@ -30,7 +30,7 @@  gdb_reinitialize_dir $srcdir/$subdir
 gdb_install_guile_utils
 gdb_install_guile_module
 
-gdb_test_no_output "guile (use-modules ((oop goops)))"
+gdb_test_no_output "guile (use-modules (oop goops) (gdb))"
 
 gdb_test_no_output "guile (define-generic +)"
 gdb_test_no_output "guile (define-method (+ (x <gdb:value>) (y <gdb:value>)) (value-add x y))"