* data-directory/Makefile.in (GUILE_FILES): Add support.scm.
* guile/lib/gdb/support.scm: New file.
* guile/guile.c (gdbscm_init_module_name): Change to "gdb".
* guile/lib/gdb.scm: Load gdb/init.scm as an include file.
All uses updated.
* guile/lib/gdb/init.scm (SCM_ARG1, SCM_ARG2): Moved to support.scm.
All uses updated.
(%assert-type): Ditto, and renamed to assert-type.
(%exception-print-style): Delete.
testsuite/
* gdb.guile/types-module.exp: Add tests for wrong type arguments.
+2014-07-26 Ludovic Courtès <ludo@gnu.org>
+ Doug Evans <xdje42@gmail.com>
+
+ PR guile/17146
+ * data-directory/Makefile.in (GUILE_FILES): Add support.scm.
+ * guile/lib/gdb/support.scm: New file.
+ * guile/guile.c (gdbscm_init_module_name): Change to "gdb".
+ * guile/lib/gdb.scm: Load gdb/init.scm as an include file.
+ All uses updated.
+ * guile/lib/gdb/init.scm (SCM_ARG1, SCM_ARG2): Moved to support.scm.
+ All uses updated.
+ (%assert-type): Ditto, and renamed to assert-type.
+ (%exception-print-style): Delete.
+
2014-07-26 Doug Evans <xdje42@gmail.com>
PR build/17105
gdb/init.scm \
gdb/iterator.scm \
gdb/printing.scm \
+ gdb/support.scm \
gdb/types.scm
@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_FILE_LIST)
/* The name of the various modules (without the surrounding parens). */
const char gdbscm_module_name[] = "gdb";
-const char gdbscm_init_module_name[] = "gdb init";
+const char gdbscm_init_module_name[] = "gdb";
/* The name of the bootstrap file. */
static const char boot_scm_filename[] = "boot.scm";
;; Load the rest of the Scheme side.
-(use-modules ((gdb init)))
+(include "gdb/init.scm")
;; These come from other files, but they're really part of this module.
-(re-export
+(export
;; init.scm
orig-input-port
(load-from-path "gdb.scm")
;; Now that the Scheme side support is loaded, initialize it.
-(let ((init-proc (@@ (gdb init) %initialize!)))
+(let ((init-proc (@@ (gdb) %initialize!)))
(init-proc))
;; E.g., (gdb experimental ports), etc.
(define-module (gdb experimental)
- #:use-module (gdb)
- #:use-module (gdb init))
+ #:use-module (gdb))
;; These are defined in C.
(define-public with-gdb-output-to-port (@@ (gdb) %with-gdb-output-to-port))
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-(define-module (gdb init)
- #:use-module (gdb))
-
-(define-public SCM_ARG1 1)
-(define-public SCM_ARG2 2)
+;; This file is included by (gdb).
;; The original i/o ports. In case the user wants them back.
(define %orig-input-port #f)
(define %orig-output-port #f)
(define %orig-error-port #f)
-;; %exception-print-style is exported as "private" by gdb.
-(define %exception-print-style (@@ (gdb) %exception-print-style))
-
;; Keys for GDB-generated exceptions.
;; gdb:with-stack is handled separately.
(%print-exception-message port frame key args)))))
-;; Internal utility to check the type of an argument, akin to SCM_ASSERT_TYPE.
-;; It's public so other gdb modules can use it.
-
-(define-public (%assert-type test-result arg pos func-name)
- (if (not test-result)
- (scm-error 'wrong-type-arg func-name
- "Wrong type argument in position ~a: ~s"
- (list pos arg) (list arg))))
-
;; Internal utility called during startup to initialize the Scheme side of
;; GDB+Guile.
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(define-module (gdb iterator)
- #:use-module (gdb))
+ #:use-module (gdb)
+ #:use-module (gdb support))
(define-public (make-list-iterator l)
"Return a <gdb:iterator> object for a list."
- (%assert-type (list? l) l SCM_ARG1 'make-list-iterator)
+ (assert-type (list? l) l SCM_ARG1 'make-list-iterator "list")
(let ((next! (lambda (iter)
(let ((l (iterator-progress iter)))
(if (eq? l '())
pretty-printers set-pretty-printers!
objfile-pretty-printers set-objfile-pretty-printers!
progspace-pretty-printers set-progspace-pretty-printers!))
- #:use-module (gdb init))
+ #:use-module (gdb support))
(define-public (prepend-pretty-printer! obj matcher)
"Add MATCHER to the beginning of the pretty-printer list for OBJ.
If OBJ is #f, add MATCHER to the global list."
- (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
- 'prepend-pretty-printer!)
+ (assert-type (pretty-printer? matcher) matcher SCM_ARG1
+ 'prepend-pretty-printer! "pretty-printer")
(cond ((eq? obj #f)
(set-pretty-printers! (cons matcher (pretty-printers))))
((objfile? obj)
(set-progspace-pretty-printers!
obj (cons matcher (progspace-pretty-printers obj))))
(else
- (%assert-type #f obj SCM_ARG1 'prepend-pretty-printer!))))
+ (assert-type #f obj SCM_ARG1 'prepend-pretty-printer!
+ "#f, objfile, or progspace"))))
(define-public (append-pretty-printer! obj matcher)
"Add MATCHER to the end of the pretty-printer list for OBJ.
If OBJ is #f, add MATCHER to the global list."
- (%assert-type (pretty-printer? matcher) matcher SCM_ARG1
- 'append-pretty-printer!)
+ (assert-type (pretty-printer? matcher) matcher SCM_ARG1
+ 'append-pretty-printer! "pretty-printer")
(cond ((eq? obj #f)
(set-pretty-printers! (append! (pretty-printers) (list matcher))))
((objfile? obj)
(set-progspace-pretty-printers!
obj (append! (progspace-pretty-printers obj) (list matcher))))
(else
- (%assert-type #f obj SCM_ARG1 'append-pretty-printer!))))
+ (assert-type #f obj SCM_ARG1 'append-pretty-printer!
+ "#f, objfile, or progspace"))))
--- /dev/null
+;; Internal support routines.
+;;
+;; Copyright (C) 2014 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/>.
+
+(define-module (gdb support))
+
+;; Symbolic values for the ARG parameter of assert-type.
+
+(define-public SCM_ARG1 1)
+(define-public SCM_ARG2 2)
+
+;; Utility to check the type of an argument, akin to SCM_ASSERT_TYPE.
+
+(define-public (assert-type test-result arg pos func-name expecting)
+ (if (not test-result)
+ (scm-error 'wrong-type-arg func-name
+ "Wrong type argument in position ~a (expecting ~a): ~s"
+ (list pos expecting arg) (list arg))))
(define-module (gdb types)
#:use-module (gdb)
- #:use-module (gdb init)
- #:use-module (gdb iterator))
+ #:use-module (gdb iterator)
+ #:use-module (gdb support))
(define-public (type-has-field-deep? type field-name)
"Return #t if the type, including baseclasses, has the specified field.
(set! type (type-target type)))
(set! type (type-strip-typedefs type))
- (%assert-type (memq (type-code type) (list TYPE_CODE_STRUCT TYPE_CODE_UNION))
- type SCM_ARG1 'type-has-field-deep?)
+ (assert-type (memq (type-code type) (list TYPE_CODE_STRUCT TYPE_CODE_UNION))
+ type SCM_ARG1 'type-has-field-deep? "struct or union")
(search-class type))
Raises:
wrong-type-arg: The type is not an enum."
- (%assert-type (= (type-code enum-type) TYPE_CODE_ENUM)
- enum-type SCM_ARG1 'make-enum-hashtable)
+ (assert-type (= (type-code enum-type) TYPE_CODE_ENUM)
+ enum-type SCM_ARG1 'make-enum-hashtable "enum")
(let ((htab (make-hash-table)))
(for-each (lambda (enum)
(hash-set! htab (field-name enum) (field-enumval enum)))
+2014-07-26 Ludovic Courtès <ludo@gnu.org>
+ Doug Evans <xdje42@gmail.com>
+
+ PR guile/17146
+ * gdb.guile/types-module.exp: Add tests for wrong type arguments.
+
2014-07-25 Pedro Alves <palves@redhat.com>
* gdb.threads/signal-command-handle-nopass.c: New file.
gdb_test "guile (print (type-has-field-deep? d \"base_member\"))" \
"= #t" "type-has-field-deep? member in baseclass"
+gdb_test "guile (print (type-has-field-deep? (lookup-type \"int\") \"base_member\"))" \
+ "ERROR: .*Wrong type argument in position 1 \\(expecting struct or union\\): #<gdb:type int>.*" \
+ "type-has-field-deep? from int"
+
gdb_scm_test_silent_cmd "guile (define enum-htab (make-enum-hashtable (lookup-type \"enum_type\")))" \
"create enum hash table"
gdb_test "guile (print (hash-ref enum-htab \"B\"))" \
"= 1" "verify make-enum-hashtable"
+
+gdb_test "guile (define bad-enum-htab (make-enum-hashtable #f))" \
+ "ERROR: .*Wrong type argument in position 1 \\(expecting gdb:type\\): #f.*" \
+ "make-enum-hashtable from #f"
+
+gdb_test "guile (define bad-enum-htab (make-enum-hashtable (lookup-type \"int\")))" \
+ "ERROR: .*Wrong type argument in position 1 \\(expecting enum\\): #<gdb:type int>.*" \
+ "make-enum-hashtable from int"
projects / external / binutils.git / commitdiff