[PATCH v1 33/36] Guile extension language: generic,goops tests

[Doug Evans <xdje42 at gmail dot com>]

This patch adds a few tests for using gdb smobs with generics and Goops.

smobs aren't first class Goops objects, but one can use generics.
Full support for Goops is left for a later pass, this patch tests
the basic infrastructure that will be used.

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

	testsuite/
	* gdb.guile/scm-generics.exp: New file.
	* gdb.guile/scm-goops.exp: New file.
	* gdb.guile/scm-goops.scm: New file.

diff --git a/gdb/testsuite/gdb.guile/scm-generics.exp b/gdb/testsuite/gdb.guile/scm-generics.exp
new file mode 100644
index 0000000..08b5518
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-generics.exp
@@ -0,0 +1,42 @@
+# Copyright (C) 2010-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 using GDB smobs with generics.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+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 (define-generic +)"
+gdb_test_no_output "guile (define-method (+ (x <gdb:value>) (y <gdb:value>)) (value-add x y))"
+
+gdb_test_no_output "guile (define x (make-value 42))"
+
+gdb_test_no_output "guile (define y (+ x x))"
+
+gdb_test "guile y" "#<gdb:value 84>"
diff --git a/gdb/testsuite/gdb.guile/scm-goops.exp b/gdb/testsuite/gdb.guile/scm-goops.exp
new file mode 100644
index 0000000..708ede3
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-goops.exp
@@ -0,0 +1,77 @@
+# Copyright (C) 2010-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 using GDB smobs with GOOPS.
+
+load_lib gdb-guile.exp
+
+standard_testfile
+
+# Make this available to gdb.
+# Give the file a new name so we don't clobber the real one if
+# objfile == srcdir.
+# FIXME: Can we get gdb_remote_download to call standard_output_file for us?
+set remote_guile_file [gdb_remote_download host \
+			   ${srcdir}/${subdir}/${testfile}.scm \
+			   ${subdir}/t-${testfile}.scm]
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+# Useful for debugging, and the error tests verify a backtrace is printed.
+gdb_test_no_output "set guile print-stack full"
+
+# Heads up: The output could be several lines of compilation notes or nothing
+# if the cached copy of the compilation is still valid.
+gdb_test "guile (load \"${remote_guile_file}\")" ""
+
+# Install the converters.
+gdb_test_no_output "guile (set-smob-converters! smob->scm scm->smob)"
+
+gdb_test_no_output "guile (define x (make-value 42))"
+
+gdb_test "guile (class-of x)" "#<<class> <my-value> $ghex>"
+
+gdb_test "guile (get-value x)" "#<gdb:value 42>"
+
+gdb_test_no_output "guile (define y (value-add x x))"
+
+gdb_test "guile (class-of y)" "#<<class> <my-value> $ghex>"
+
+gdb_test "guile (get-value y)" "#<gdb:value 84>"
+
+# Install "bad" converters and verify gdb properly flags the error.
+
+gdb_test_no_output "guile (set-smob-converters! smob->scm bad:scm->smob)"
+
+gdb_test "p 23" "= 23"
+gdb_test_no_output "guile (define x (history-ref 0))"
+
+gdb_test "guile (get-value x)" "<gdb:value 23>" "verify smob->scm, error test"
+
+gdb_test "guile (define y (value-sub x x))" \
+    "Backtrace:.* Unbound variable: misspelled-doesnt-exist.*" \
+    "error message from bad *scm->smob*"
+
+gdb_test_no_output "guile (set-smob-converters! bad:smob->scm bad:scm->smob)"
+
+gdb_test "guile (define x (history-ref 0))" \
+    "Backtrace:.* Unbound variable: misspelled-doesnt-exist.*" \
+    "error message from bad *smob->scm*"
diff --git a/gdb/testsuite/gdb.guile/scm-goops.scm b/gdb/testsuite/gdb.guile/scm-goops.scm
new file mode 100644
index 0000000..76716ba
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-goops.scm
@@ -0,0 +1,53 @@
+;; Copyright (C) 2010-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.
+;; Exercise Goops support.
+;; This feature is currently experimental.
+
+(use-modules ((gdb)) ((gdb experimental)))
+(use-modules ((oop goops)))
+
+(define-class <my-value> () (value #:init-keyword #:value #:getter get-value))
+
+;; SMOB will always be a gdb smob.
+(define (smob->scm smob)
+  (let ((kind (gsmob-kind smob)))
+    (case kind
+      ((<gdb:value>) (make <my-value> #:value smob))
+      (else #f))))
+
+;; N.B.: SCM can be any value, not necessarily the result of smob->scm.
+(define (scm->smob scm)
+  (let ((kind (class-of scm)))
+    (cond
+     ((eq? kind <my-value>) (get-value scm))
+     (else #f))))
+
+;; Do this to install the converters.
+;;(set-smob-converters! smob->scm scm->smob)
+
+;; Versions of converters that throw errors to verify GDB recovers.
+
+;; SMOB will always be a gdb smob.
+(define (bad:smob->scm smob)
+  (misspelled-doesnt-exist smob))
+
+;; N.B.: SCM can be any value, not necessarily the result of smob->scm.
+(define (bad:scm->smob scm)
+  (misspelled-doesnt-exist scm))
+
+;; Do this to install the converters.
+;;(set-smob-converters! bad:smob->scm bad:scm->smob)