PR guile/17146 preparatory work.

	* 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.

9 files changed, 57 insertions, 38 deletions

diff --git a/gdb/guile/guile.c b/gdb/guile/guile.c
index 6bc078f..e81cb4c 100644
--- a/gdb/guile/guile.c
+++ b/gdb/guile/guile.c
@@ -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";
diff --git a/gdb/guile/lib/gdb.scm b/gdb/guile/lib/gdb.scm
index 4fd4699..552bfe9 100644
--- a/gdb/guile/lib/gdb.scm
+++ b/gdb/guile/lib/gdb.scm
@@ -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
diff --git a/gdb/guile/lib/gdb/boot.scm b/gdb/guile/lib/gdb/boot.scm
index 8c0bb35..6159354 100644
--- a/gdb/guile/lib/gdb/boot.scm
+++ b/gdb/guile/lib/gdb/boot.scm
@@ -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))
diff --git a/gdb/guile/lib/gdb/experimental.scm b/gdb/guile/lib/gdb/experimental.scm
index ffded84..9e5a53e 100644
--- a/gdb/guile/lib/gdb/experimental.scm
+++ b/gdb/guile/lib/gdb/experimental.scm
@@ -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))
diff --git a/gdb/guile/lib/gdb/init.scm b/gdb/guile/lib/gdb/init.scm
index 7607d49..98888ed 100644
--- a/gdb/guile/lib/gdb/init.scm
+++ b/gdb/guile/lib/gdb/init.scm
@@ -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.
 
diff --git a/gdb/guile/lib/gdb/iterator.scm b/gdb/guile/lib/gdb/iterator.scm
index 9cfbe85..2748931 100644
--- a/gdb/guile/lib/gdb/iterator.scm
+++ b/gdb/guile/lib/gdb/iterator.scm
@@ -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 '())
diff --git a/gdb/guile/lib/gdb/printing.scm b/gdb/guile/lib/gdb/printing.scm
index 2d1274f..4e4fb91 100644
--- a/gdb/guile/lib/gdb/printing.scm
+++ b/gdb/guile/lib/gdb/printing.scm
@@ -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"))))
diff --git a/gdb/guile/lib/gdb/support.scm b/gdb/guile/lib/gdb/support.scm
new file mode 100644
index 0000000..dc6c20f
--- /dev/null
+++ b/gdb/guile/lib/gdb/support.scm
@@ -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))))
diff --git a/gdb/guile/lib/gdb/types.scm b/gdb/guile/lib/gdb/types.scm
index 31ea192..296d170 100644
--- a/gdb/guile/lib/gdb/types.scm
+++ b/gdb/guile/lib/gdb/types.scm
@@ -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)))