mirror/binutils-gdb
2
0
Fork 0
mirror of https://sourceware.org/git/binutils-gdb.git synced 2024-11-21 01:12:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

PR guile/17146 preparatory work.

Browse Source 
* 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.
This commit is contained in:
Doug Evans 2014-07-26 17:01:09 -07:00
parent 4122867a42
commit 186fcde0c6
13 changed files with 90 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gdb/ChangeLog
View File

@ -1,3 +1,17 @@
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

1
gdb/data-directory/Makefile.in
View File

@ -87,6 +87,7 @@ GUILE_FILE_LIST = \
gdb/init.scm \
gdb/iterator.scm \
gdb/printing.scm \
gdb/support.scm \
gdb/types.scm
@HAVE_GUILE_TRUE@GUILE_FILES = $(GUILE_FILE_LIST)

2
gdb/guile/guile.c
View File

@ -120,7 +120,7 @@ static SCM to_string_keyword;
/* 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";

4
gdb/guile/lib/gdb.scm
View File

@ -494,11 +494,11 @@
;; 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

2
gdb/guile/lib/gdb/boot.scm
View File

@ -26,5 +26,5 @@
(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))

3
gdb/guile/lib/gdb/experimental.scm
View File

@ -22,8 +22,7 @@
;; 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))

18
gdb/guile/lib/gdb/init.scm
View File

@ -17,20 +17,13 @@
;; 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.
@ -142,15 +135,6 @@
(%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.

5
gdb/guile/lib/gdb/iterator.scm
View File

@ -19,11 +19,12 @@
;; 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 '())

16
gdb/guile/lib/gdb/printing.scm
View File

@ -23,13 +23,13 @@
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)
@ -39,13 +39,14 @@ If OBJ is #f, add MATCHER to the global list."
(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)
@ -55,4 +56,5 @@ If OBJ is #f, add MATCHER to the global list."
(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"))))

33
gdb/guile/lib/gdb/support.scm Normal file
View File

@ -0,0 +1,33 @@
;; 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))))

12
gdb/guile/lib/gdb/types.scm
View File

@ -16,8 +16,8 @@
(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.
@ -50,8 +50,8 @@
(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))
@ -69,8 +69,8 @@
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)))

6
gdb/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
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.

12
gdb/testsuite/gdb.guile/types-module.exp
View File

@ -43,8 +43,20 @@ gdb_test "guile (print (type-has-field? d \"base_member\"))" \
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"