[PATCH v1 25/36] Guile extension language: scm-objfile.c

[Doug Evans <xdje42 at gmail dot com>]

This patch adds the interface to objfiles.

2013-12-24  Doug Evans  <xdje42@gmail.com>

	* guile/scm-objfile.c: New file.

	testsuite/
	* gdb.guile/scm-objfile-script-gdb.in: New file.
	* gdb.guile/scm-objfile-script.c: New file.
	* gdb.guile/scm-objfile-script.exp: New file.
	* gdb.guile/scm-objfile.c: New file.
	* gdb.guile/scm-objfile.exp: New file.

diff --git a/gdb/guile/scm-objfile.c b/gdb/guile/scm-objfile.c
new file mode 100644
index 0000000..23ea988
--- /dev/null
+++ b/gdb/guile/scm-objfile.c
@@ -0,0 +1,471 @@
+/* Scheme interface to objfiles.
+
+   Copyright (C) 2008-2013 Free Software Foundation, Inc.
+
+   This file is part of GDB.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* See README file in this directory for implementation notes, coding
+   conventions, et.al.  */
+
+#include "defs.h"
+#include "objfiles.h"
+#include "language.h"
+#include "guile-internal.h"
+
+/* The <gdb:objfile> smob.
+   The typedef for this struct is in guile-internal.h.  */
+
+struct _objfile_smob
+{
+  /* This always appears first.  */
+  gdb_smob base;
+
+  /* The corresponding objfile.  */
+  struct objfile *objfile;
+
+  /* The pretty-printer list of functions.  */
+  SCM pretty_printers;
+
+  /* The <gdb:objfile> object we are contained in, needed to protect/unprotect
+     the object since a reference to it comes from non-gc-managed space
+     (the objfile).  */
+  SCM containing_scm;
+
+  /* The result of passing containing_scm through *smob->scm*.
+     This value is initialized to SCM_UNDEFINED and is lazily computed.
+     If there is no *smob->scm* procedure it is set to #f.  */
+  SCM converted_containing_scm;
+};
+
+static const char objfile_smob_name[] = "gdb:objfile";
+
+/* The tag Guile knows the objfile smob by.  */
+static scm_t_bits objfile_smob_tag;
+
+static const struct objfile_data *ofscm_objfile_data_key;
+
+/* Return the list of pretty-printers registered with O_SMOB.  */
+
+SCM
+ofscm_objfile_smob_pretty_printers (objfile_smob *o_smob)
+{
+  return o_smob->pretty_printers;
+}
+
+/* Administrivia for objfile smobs.  */
+
+/* The smob "mark" function for <gdb:objfile>.  */
+
+static SCM
+ofscm_mark_objfile_smob (SCM self)
+{
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
+
+  scm_gc_mark (o_smob->pretty_printers);
+
+  /* We don't mark containing_scm, converted_containing_scm here.
+     Those are just backlinks to our container, and are gc'protected
+     until the objfile is deleted.  */
+
+  /* Do this last.  */
+  return gdbscm_mark_gsmob (&o_smob->base);
+}
+
+/* The smob "print" function for <gdb:objfile>.  */
+
+static int
+ofscm_print_objfile_smob (SCM self, SCM port, scm_print_state *pstate)
+{
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (self);
+
+  gdbscm_printf (port, "#<%s ", objfile_smob_name);
+  gdbscm_printf (port, "%s",
+		 o_smob->objfile != NULL
+		 ? objfile_name (o_smob->objfile)
+		 : "{invalid}");
+  scm_puts (">", port);
+
+  scm_remember_upto_here_1 (self);
+
+  /* Non-zero means success.  */
+  return 1;
+}
+
+/* Low level routine to create a <gdb:objfile> object.
+   It's empty in the sense that an OBJFILE still needs to be associated
+   with it.  */
+
+static SCM
+ofscm_make_objfile_gsmob (void)
+{
+  objfile_smob *o_smob = (objfile_smob *)
+    scm_gc_malloc (sizeof (objfile_smob), objfile_smob_name);
+  SCM o_scm;
+
+  o_smob->objfile = NULL;
+  o_smob->pretty_printers = SCM_EOL;
+  o_scm = scm_new_smob (objfile_smob_tag, (scm_t_bits) o_smob);
+  o_smob->containing_scm = o_scm;
+  o_smob->converted_containing_scm = SCM_UNDEFINED;
+  gdbscm_init_gsmob (&o_smob->base);
+
+  return o_scm;
+}
+
+/* Clear the OBJFILE pointer in O_SMOB and unprotect the object from GC.  */
+
+static void
+ofscm_release_objfile (objfile_smob *o_smob)
+{
+  o_smob->objfile = NULL;
+  scm_gc_unprotect_object (o_smob->containing_scm);
+  if (!SCM_UNBNDP (o_smob->converted_containing_scm)
+      && !gdbscm_is_false (o_smob->converted_containing_scm))
+    scm_gc_unprotect_object (o_smob->converted_containing_scm);
+}
+
+/* Objfile registry cleanup handler for when an objfile is deleted.  */
+
+static void
+ofscm_handle_objfile_deleted (struct objfile *objfile, void *datum)
+{
+  objfile_smob *o_smob = datum;
+
+  gdb_assert (o_smob->objfile == objfile);
+
+  ofscm_release_objfile (o_smob);
+}
+
+/* Set the converted_containing_scm field of O_SMOB to SCM.
+   SCM is either #f or the result of passing containing_scm through
+   *smob->scm*.
+   The object is protected from GC until the objfile is freed.  */
+
+static void
+ofscm_set_converted_containing_scm (objfile_smob *o_smob, SCM scm)
+{
+  gdb_assert (SCM_UNBNDP (o_smob->converted_containing_scm));
+
+  o_smob->converted_containing_scm = scm;
+  if (!gdbscm_is_false (scm))
+    scm_gc_protect_object (scm);
+}
+
+/* Return non-zero if SCM is a <gdb:objfile> object.  */
+
+static int
+ofscm_is_objfile (SCM scm)
+{
+  return SCM_SMOB_PREDICATE (objfile_smob_tag, scm);
+}
+
+/* (objfile? object) -> boolean */
+
+static SCM
+gdbscm_objfile_p (SCM scm)
+{
+  return scm_from_bool (ofscm_is_objfile (scm));
+}
+
+/* Return a pointer to the objfile_smob that encapsulates OBJFILE,
+   creating one if necessary.
+   The result is cached so that we have only one copy per objfile.  */
+
+objfile_smob *
+ofscm_objfile_smob_from_objfile (struct objfile *objfile)
+{
+  objfile_smob *o_smob;
+
+  o_smob = objfile_data (objfile, ofscm_objfile_data_key);
+  if (o_smob == NULL)
+    {
+      SCM o_scm = ofscm_make_objfile_gsmob ();
+
+      o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
+      o_smob->objfile = objfile;
+
+      set_objfile_data (objfile, ofscm_objfile_data_key, o_smob);
+      scm_gc_protect_object (o_smob->containing_scm);
+    }
+
+  return o_smob;
+}
+
+/* Return the  <gdb:objfile> object that encapsulates OBJFILE,
+   passing it through *smob->scm*.
+   A Scheme exception is thrown if there is an error.  */
+
+SCM
+ofscm_scm_from_objfile_unsafe (struct objfile *objfile)
+{
+  objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
+  SCM result;
+
+  result = o_smob->converted_containing_scm;
+  if (SCM_UNBNDP (result))
+    {
+      result = gdbscm_scm_from_gsmob_safe (o_smob->containing_scm);
+
+      if (gdbscm_is_exception (result))
+	gdbscm_throw (result);
+
+      ofscm_set_converted_containing_scm (o_smob, result);
+    }
+
+  return result;
+}
+
+/* Returns the <gdb:objfile> object in SCM or #f if SCM is not a
+   <gdb:objfile> object.
+   Returns a <gdb:exception> object if there was a problem during the
+   conversion.  */
+
+static SCM
+ofscm_scm_to_objfile_gsmob (SCM scm)
+{
+  return gdbscm_scm_to_gsmob_safe (scm, objfile_smob_tag);
+}
+
+/* Returns the <gdb:objfile> object in SELF.
+   Throws an exception if SELF is not a <gdb:objfile> object
+   (after passing it through *scm->smob*).  */
+
+static SCM
+ofscm_get_objfile_arg_unsafe (SCM self, int arg_pos, const char *func_name)
+{
+  SCM o_scm = ofscm_scm_to_objfile_gsmob (self);
+
+  if (gdbscm_is_exception (o_scm))
+    gdbscm_throw (o_scm);
+
+  SCM_ASSERT_TYPE (ofscm_is_objfile (o_scm), self, arg_pos, func_name,
+		   objfile_smob_name);
+
+  return o_scm;
+}
+
+/* Returns a pointer to the objfile smob of SELF.
+   Throws an exception if SELF is not a <gdb:objfile> object
+   (after passing it through *scm->smob*).  */
+
+static objfile_smob *
+ofscm_get_objfile_smob_arg_unsafe (SCM self, int arg_pos,
+				   const char *func_name)
+{
+  SCM o_scm = ofscm_get_objfile_arg_unsafe (self, arg_pos, func_name);
+  objfile_smob *o_smob = (objfile_smob *) SCM_SMOB_DATA (o_scm);
+
+  return o_smob;
+}
+
+/* Return non-zero if objfile O_SMOB is valid.  */
+
+static int
+ofscm_is_valid (objfile_smob *o_smob)
+{
+  return o_smob->objfile != NULL;
+}
+
+/* Return the objfile smob in SELF, verifying it's valid.
+   Throws an exception if SELF is not a <gdb:objfile> object or is invalid
+   (after passing it through *scm->smob*).  */
+
+static objfile_smob *
+ofscm_get_valid_objfile_smob_arg_unsafe (SCM self, int arg_pos,
+					 const char *func_name)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, arg_pos, func_name);
+
+  if (!ofscm_is_valid (o_smob))
+    {
+      gdbscm_invalid_object_error (func_name, arg_pos, self,
+				   _("<gdb:objfile>"));
+    }
+
+  return o_smob;
+}
+
+/* Objfile methods.  */
+
+/* (objfile-valid? <gdb:objfile>) -> boolean
+   Returns #t if this object file still exists in GDB.  */
+
+static SCM
+gdbscm_objfile_valid_p (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return scm_from_bool (o_smob->objfile != NULL);
+}
+
+/* (objfile-filename <gdb:objfile>) -> string
+   Returns the objfile's file name.
+   Throw's an exception if the underlying objfile is invalid.  */
+
+static SCM
+gdbscm_objfile_filename (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_valid_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return gdbscm_scm_from_c_string (objfile_name (o_smob->objfile));
+}
+
+/* (objfile-pretty-printers <gdb:objfile>) -> list
+   Returns the list of pretty-printers for this objfile.  */
+
+static SCM
+gdbscm_objfile_pretty_printers (SCM self)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  return o_smob->pretty_printers;
+}
+
+/* (set-objfile-pretty-printers! <gdb:objfile> list) -> unspecified
+   Set the pretty-printers for this objfile.  */
+
+static SCM
+gdbscm_set_objfile_pretty_printers_x (SCM self, SCM printers)
+{
+  objfile_smob *o_smob
+    = ofscm_get_objfile_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
+
+  SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
+		   SCM_ARG2, FUNC_NAME, _("list"));
+
+  o_smob->pretty_printers = printers;
+
+  return SCM_UNSPECIFIED;
+}
+
+/* The "current" objfile.  This is set when gdb detects that a new
+   objfile has been loaded.  It is only set for the duration of a call to
+   gdbscm_source_objfile_script; it is NULL at other times.  */
+static struct objfile *ofscm_current_objfile;
+
+/* Set the current objfile to OBJFILE and then read FILE named FILENAME
+   as Guile code.  This does not throw any errors.  If an exception
+   occurs Guile will print the backtrace.
+   This is the extension_language_script_ops.objfile_script_sourcer
+   "method".  */
+
+void
+gdbscm_source_objfile_script (const struct extension_language_defn *extlang,
+			      struct objfile *objfile, FILE *file,
+			      const char *filename)
+{
+  char *msg;
+
+  ofscm_current_objfile = objfile;
+
+  msg = gdbscm_safe_source_script (filename);
+  if (msg != NULL)
+    {
+      fprintf_filtered (gdb_stderr, "%s", msg);
+      xfree (msg);
+    }
+
+  ofscm_current_objfile = NULL;
+}
+
+/* (current-objfile) -> <gdb:obfjile>
+   Return the current objfile, or #f if there isn't one.
+   Ideally this would be named ofscm_current_objfile, but that name is
+   taken by the variable recording the current objfile.  */
+
+static SCM
+gdbscm_get_current_objfile (void)
+{
+  if (ofscm_current_objfile == NULL)
+    return SCM_BOOL_F;
+
+  return ofscm_scm_from_objfile_unsafe (ofscm_current_objfile);
+}
+
+/* (objfiles) -> list
+   Return a list of all objfiles in the current program space.  */
+
+static SCM
+gdbscm_objfiles (void)
+{
+  struct objfile *objf;
+  SCM result;
+
+  result = SCM_EOL;
+
+  ALL_OBJFILES (objf)
+  {
+    SCM item = ofscm_scm_from_objfile_unsafe (objf);
+
+    result = scm_cons (item, result);
+  }
+
+  return scm_reverse_x (result, SCM_EOL);
+}
+
+/* Initialize the Scheme objfile support.  */
+
+static const scheme_function objfile_functions[] =
+{
+  { "objfile?", 1, 0, 0, gdbscm_objfile_p,
+    "\
+Return #t if the object is a <gdb:objfile> object." },
+
+  { "objfile-valid?", 1, 0, 0, gdbscm_objfile_valid_p,
+    "\
+Return #t if the objfile is valid (hasn't been deleted from gdb)." },
+
+  { "objfile-filename", 1, 0, 0, gdbscm_objfile_filename,
+    "\
+Return the file name of the objfile." },
+
+  { "objfile-pretty-printers", 1, 0, 0, gdbscm_objfile_pretty_printers,
+    "\
+Return a list of pretty-printers of the objfile." },
+
+  { "set-objfile-pretty-printers!", 2, 0, 0,
+    gdbscm_set_objfile_pretty_printers_x,
+    "\
+Set the list of pretty-printers of the objfile." },
+
+  { "current-objfile", 0, 0, 0, gdbscm_get_current_objfile,
+    "\
+Return the current objfile if there is one or #f if there isn't one." },
+
+  { "objfiles", 0, 0, 0, gdbscm_objfiles,
+    "\
+Return a list of all objfiles in the current program space." },
+
+  END_FUNCTIONS
+};
+
+void
+gdbscm_initialize_objfiles (void)
+{
+  objfile_smob_tag
+    = gdbscm_make_smob_type (objfile_smob_name, sizeof (objfile_smob));
+  scm_set_smob_mark (objfile_smob_tag, ofscm_mark_objfile_smob);
+  scm_set_smob_print (objfile_smob_tag, ofscm_print_objfile_smob);
+
+  gdbscm_define_functions (objfile_functions, 1);
+
+  ofscm_objfile_data_key
+    = register_objfile_data_with_cleanup (NULL, ofscm_handle_objfile_deleted);
+}
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in b/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in
new file mode 100644
index 0000000..5e0d578
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script-gdb.in
@@ -0,0 +1,55 @@
+;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;; This file is part of the GDB testsuite.
+
+(use-modules (gdb) (gdb printing))
+
+(define (make-pp_ss-printer val)
+  (make-pretty-printer-worker
+   #f
+   (lambda (printer)
+     (let ((a (value-field val "a"))
+	   (b (value-field val "b")))
+       (format #f "a=<~A> b=<~A>" a b)))
+   #f))
+
+(define (get-type-for-printing val)
+  "Return type of val, stripping away typedefs, etc."
+  (let ((type (value-type val)))
+    (if (= (type-code type) TYPE_CODE_REF)
+	(set! type (type-target type)))
+    (type-strip-typedefs (type-unqualified type))))
+
+(define (make-pretty-printer-dict)
+  (let ((dict (make-hash-table)))
+    (hash-set! dict "struct ss" make-pp_ss-printer)
+    (hash-set! dict "ss" make-pp_ss-printer)
+    dict))
+
+(define *pretty-printer*
+ (make-pretty-printer
+  "pretty-printer-test"
+  (let ((pretty-printers-dict (make-pretty-printer-dict)))
+    (lambda (matcher val)
+      "Look-up and return a pretty-printer that can print val."
+      (let ((type (get-type-for-printing val)))
+	(let ((typename (type-tag type)))
+	  (if typename
+	      (let ((printer-maker (hash-ref pretty-printers-dict typename)))
+		(and printer-maker (printer-maker val)))
+	      #f)))))))
+
+(append-pretty-printer! #f *pretty-printer*)
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script.c b/gdb/testsuite/gdb.guile/scm-objfile-script.c
new file mode 100644
index 0000000..ed50d48
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script.c
@@ -0,0 +1,39 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2011-2013 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+struct ss
+{
+  int a;
+  int b;
+};
+
+void
+init_ss (struct ss *s, int a, int b)
+{
+  s->a = a;
+  s->b = b;
+}
+
+int
+main ()
+{
+  struct ss ss;
+
+  init_ss (&ss, 1, 2);
+
+  return 0;      /* break to inspect struct and union */
+}
diff --git a/gdb/testsuite/gdb.guile/scm-objfile-script.exp b/gdb/testsuite/gdb.guile/scm-objfile-script.exp
new file mode 100644
index 0000000..ed3834b
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile-script.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the GDB testsuite.
+# It tests automagic loading of -gdb.scm scripts.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if {[build_executable $testfile.exp $testfile $srcfile debug] == -1} {
+    return
+}
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# Make the -gdb.scm script available to gdb, it is automagically loaded by gdb.
+# Care is taken to put it in the same directory as the binary so that
+# gdb will find it.
+set remote_guile_file [remote_download host \
+			   ${srcdir}/${subdir}/${testfile}-gdb.in \
+			   [standard_output_file ${testfile}-gdb.scm]]
+
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_test_no_output "set auto-load safe-path ${remote_guile_file}" \
+    "set auto-load safe-path"
+gdb_load ${binfile}
+
+# Verify gdb loaded the script.
+gdb_test "info auto-load guile-scripts" "Yes.*/${testfile}-gdb.scm.*"
+
+if ![gdb_guile_runto_main] {
+    return
+}
+
+gdb_test "b [gdb_get_line_number {break to inspect} ${testfile}.c ]" \
+    ".*Breakpoint.*"
+gdb_test "continue" ".*Breakpoint.*"
+
+gdb_test "print ss" " = a=<1> b=<2>"
diff --git a/gdb/testsuite/gdb.guile/scm-objfile.c b/gdb/testsuite/gdb.guile/scm-objfile.c
new file mode 100644
index 0000000..893d6f4
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile.c
@@ -0,0 +1,23 @@
+/* This testcase is part of GDB, the GNU debugger.
+
+   Copyright 2011-2013 Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+int
+main ()
+{
+  int some_var = 0;
+  return 0;
+}
diff --git a/gdb/testsuite/gdb.guile/scm-objfile.exp b/gdb/testsuite/gdb.guile/scm-objfile.exp
new file mode 100644
index 0000000..c9f2f80
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-objfile.exp
@@ -0,0 +1,57 @@
+# Copyright (C) 2011-2013 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the GDB testsuite.
+# It tests the objfile support in Guile.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile}] } {
+    return
+}
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+if ![gdb_guile_runto_main] {
+    fail "Can't run to main"
+    return
+}
+
+gdb_scm_test_silent_cmd "gu (define sym (lookup-symbol \"some_var\"))" \
+    "Find a symbol in objfile"
+gdb_scm_test_silent_cmd "gu (define objfile (symtab-objfile (symbol-symtab (car sym))))" \
+    "Get backing object file"
+
+gdb_test "gu (print (objfile-filename objfile))" \
+    ".*scm-objfile.*" "Get objfile filename"
+gdb_test "gu (print (objfile-valid? objfile))" \
+    "#t" "Get objfile validity"
+
+gdb_test "gu (print (->bool (or-map (lambda (o) (string-contains (objfile-filename o) \"scm-objfile\")) (objfiles))))" \
+    "= #t" "scm-objfile in objfile list"
+
+gdb_test "gu (print (objfile-pretty-printers objfile))" \
+    "= \\(\\)"
+
+gdb_test "guile (set-objfile-pretty-printers! objfile 0)" \
+    "ERROR: .*: Wrong type argument in position 2 \\(expecting list\\): 0.*"
+
+# Do this last.
+gdb_unload
+gdb_test "gu (print (objfile-valid? objfile))" \
+    "#f" "Get objfile validity after unload"