Add parameter support for Guile.

	* Makefile.in (SUBDIR_GUILE_OBS): Add scm-param.o.
	(SUBDIR_GUILE_SRCS): Add scm-param.c.
	(scm-param.o): New rule.
	* guile/guile-internal.h (gdbscm_gc_dup_argv): Declare.
	(gdbscm_misc_error): Declare.
	(gdbscm_canonicalize_command_name): Declare.
	(gdbscm_scm_to_host_string): Declare.
	(gdbscm_scm_from_host_string): Declare.
	(gdbscm_initialize_parameters): Declare.
	* guile/guile.c (initialize_gdb_module): Call
	gdbscm_initialize_parameters.
	* guile/lib/gdb.scm: Export parameter symbols.
	* guile/scm-cmd.c (gdbscm_canonicalize_command_name): Renamed from
	cmdscm_canonicalize_name and made public.  All callers updated.
	* guile/scm-exception.c (gdbscm_misc_error): New function.
	* guile/scm-param.c: New file.
	* guile/scm-string.c (gdbscm_scm_to_string): Add comments.
	(gdbscm_scm_to_host_string): New function.
	(gdbscm_scm_from_host_string): New function.
	* scm-utils.c (gdbscm_gc_dup_argv): New function.

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

	doc/
	* guile.texi (Guile API): Add entry for Parameters In Guile.
	(GDB Scheme Data Types): Mention <gdb:parameter> object.
	(Parameters In Guile): New node.

1 files changed, 168 insertions, 0 deletions

diff --git a/gdb/testsuite/gdb.guile/scm-parameter.exp b/gdb/testsuite/gdb.guile/scm-parameter.exp
new file mode 100644
index 0000000000..0dd8a471d2
--- /dev/null
+++ b/gdb/testsuite/gdb.guile/scm-parameter.exp
@@ -0,0 +1,168 @@
+# Copyright (C) 2010-2014 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 GDB parameter support in Guile.
+
+load_lib gdb-guile.exp
+
+# Start with a fresh gdb.
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+
+# Skip all tests if Guile scripting is not enabled.
+if { [skip_guile_tests] } { continue }
+
+gdb_install_guile_utils
+gdb_install_guile_module
+
+# We use "." here instead of ":" so that this works on win32 too.
+gdb_test "guile (print (parameter-value \"directories\"))" "$srcdir/$subdir.\\\$cdir.\\\$cwd"
+
+# Test a simple boolean parameter, and parameter? while we're at it.
+
+gdb_test_multiline "Simple gdb boolean parameter" \
+    "guile" "" \
+    "(define test-param" "" \
+    "  (make-parameter \"print test-param\"" "" \
+    "   #:command-class COMMAND_DATA" "" \
+    "   #:parameter-type PARAM_BOOLEAN" "" \
+    "   #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \
+    "   #:set-doc \"Set the state of the boolean test-param.\"" "" \
+    "   #:show-doc \"Show the state of the boolean test-param.\"" "" \
+    "   #:show-func (lambda (self value)" ""\
+    "      (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
+    "   #:initial-value #t))" "" \
+    "(register-parameter! test-param)" "" \
+    "end"
+
+with_test_prefix "test-param" {
+    gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)"
+    gdb_test "show print test-param" "The state of the Test Parameter is on." "Show parameter on"
+    gdb_test_no_output "set print test-param off"
+    gdb_test "show print test-param" "The state of the Test Parameter is off." "Show parameter off"
+    gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)"
+    gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help"
+    gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help"
+    gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help"
+
+    gdb_test "guile (print (parameter? test-param))" "= #t"
+    gdb_test "guile (print (parameter? 42))" "= #f"
+}
+
+# Test an enum parameter.
+
+gdb_test_multiline "enum gdb parameter" \
+    "guile" "" \
+    "(define test-enum-param" "" \
+    "  (make-parameter \"print test-enum-param\"" "" \
+    "   #:command-class COMMAND_DATA" "" \
+    "   #:parameter-type PARAM_ENUM" "" \
+    "   #:enum-list '(\"one\" \"two\")" "" \
+    "   #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
+    "   #:show-doc \"Show the state of the enum.\"" "" \
+    "   #:set-doc \"Set the state of the enum.\"" "" \
+    "   #:show-func (lambda (self value)" "" \
+    "      (format #f \"The state of the enum is ~a.\" value))" "" \
+    "   #:initial-value \"one\"))" "" \
+    "(register-parameter! test-enum-param)" "" \
+    "end"
+
+with_test_prefix "test-enum-param" {
+    gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)"
+    gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value"
+    gdb_test_no_output "set print test-enum-param two"
+    gdb_test "show print test-enum-param" "The state of the enum is two." "show new value"
+    gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)"
+    gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter" 
+}
+
+# Test a file parameter.
+
+gdb_test_multiline "file gdb parameter" \
+    "guile" "" \
+    "(define test-file-param" "" \
+    "  (make-parameter \"test-file-param\"" "" \
+    "   #:command-class COMMAND_FILES" "" \
+    "   #:parameter-type PARAM_FILENAME" "" \
+    "   #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
+    "   #:show-doc \"Show the name of the file.\"" "" \
+    "   #:set-doc \"Set the name of the file.\"" "" \
+    "   #:show-func (lambda (self value)" "" \
+    "      (format #f \"The name of the file is ~a.\" value))" "" \
+    "   #:initial-value \"foo.txt\"))" "" \
+    "(register-parameter! test-file-param)" "" \
+    "end"
+
+with_test_prefix "test-file-param" {
+    gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value"
+    gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value"
+    gdb_test_no_output "set test-file-param bar.txt"
+    gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value"
+    gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value"
+    gdb_test "set test-file-param" "Argument required.*" 
+}
+
+# Test a parameter that is not documented.
+
+gdb_test_multiline "undocumented gdb parameter" \
+    "guile" "" \
+    "(register-parameter! (make-parameter \"print test-undoc-param\"" "" \
+    "   #:command-class COMMAND_DATA" "" \
+    "   #:parameter-type PARAM_BOOLEAN" "" \
+    "   #:show-func (lambda (self value)" "" \
+    "      (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
+    "   #:initial-value #t))" "" \
+    "end"
+
+with_test_prefix "test-undocumented-param" {
+    gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on"
+    gdb_test_no_output "set print test-undoc-param off"
+    gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off"
+    gdb_test "help show print test-undoc-param" "This command is not documented." "show help"
+    gdb_test "help set print test-undoc-param" "This command is not documented." "set help"
+    gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help"
+}
+
+# Test a parameter with a restricted range, where we need to notify the user
+# and restore the previous value.
+
+gdb_test_multiline "restricted gdb parameter" \
+    "guile" "" \
+    "(register-parameter! (make-parameter \"test-restricted-param\"" "" \
+    "   #:command-class COMMAND_DATA" "" \
+    "   #:parameter-type PARAM_ZINTEGER" "" \
+    "   #:set-func (lambda (self)" "" \
+    "      (let ((value (parameter-value self)))" "" \
+    "        (if (and (>= value 0) (<= value 10))" "" \
+    "            \"\"" "" \
+    "            (begin" "" \
+    "              (set-parameter-value! self (object-property self 'value))" "" \
+    "              \"Error: Range of parameter is 0-10.\"))))" "" \
+    "   #:show-func (lambda (self value)" "" \
+    "      (format #f \"The value of the restricted parameter is ~a.\" value))" "" \
+    "   #:initial-value (lambda (self)" "" \
+    "      (set-object-property! self 'value 2)" "" \
+    "      2)))" "" \
+    "end"
+
+with_test_prefix "test-restricted-param" {
+    gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
+    gdb_test_no_output "set test-restricted-param 10"
+    gdb_test "show test-restricted-param" "The value of the restricted parameter is 10."
+    gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10."
+    gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
+}