gdb/testsuite/gdb.guile/scm-parameter.exp

   1 # Copyright (C) 2010-2014 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # This file is part of the GDB testsuite.
  17 # It tests GDB parameter support in Guile.
  18
  19 load_lib gdb-guile.exp
  20
  21 # Start with a fresh gdb.
  22 gdb_exit
  23 gdb_start
  24 gdb_reinitialize_dir $srcdir/$subdir
  25
  26 # Skip all tests if Guile scripting is not enabled.
  27 if { [skip_guile_tests] } { continue }
  28
  29 gdb_install_guile_utils
  30 gdb_install_guile_module
  31
  32 # We use "." here instead of ":" so that this works on win32 too.
  33 gdb_test "guile (print (parameter-value \"directories\"))" "$srcdir/$subdir.\\\$cdir.\\\$cwd"
  34
  35 # Test a simple boolean parameter, and parameter? while we're at it.
  36
  37 gdb_test_multiline "Simple gdb boolean parameter" \
  38     "guile" "" \
  39     "(define test-param" "" \
  40     "  (make-parameter \"print test-param\"" "" \
  41     "   #:command-class COMMAND_DATA" "" \
  42     "   #:parameter-type PARAM_BOOLEAN" "" \
  43     "   #:doc \"When enabled, test param does something useful. When disabled, does nothing.\"" "" \
  44     "   #:set-doc \"Set the state of the boolean test-param.\"" "" \
  45     "   #:show-doc \"Show the state of the boolean test-param.\"" "" \
  46     "   #:show-func (lambda (self value)" ""\
  47     "      (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
  48     "   #:initial-value #t))" "" \
  49     "(register-parameter! test-param)" "" \
  50     "end"
  51
  52 with_test_prefix "test-param" {
  53     gdb_test "guile (print (parameter-value test-param))" "= #t" "parameter value (true)"
  54     gdb_test "show print test-param" "The state of the Test Parameter is on." "Show parameter on"
  55     gdb_test_no_output "set print test-param off"
  56     gdb_test "show print test-param" "The state of the Test Parameter is off." "Show parameter off"
  57     gdb_test "guile (print (parameter-value test-param))" "= #f" "parameter value (false)"
  58     gdb_test "help show print test-param" "Show the state of the boolean test-param.*" "show help"
  59     gdb_test "help set print test-param" "Set the state of the boolean test-param.*" "set help"
  60     gdb_test "help set print" "set print test-param -- Set the state of the boolean test-param.*" "general help"
  61
  62     gdb_test "guile (print (parameter? test-param))" "= #t"
  63     gdb_test "guile (print (parameter? 42))" "= #f"
  64 }
  65
  66 # Test an enum parameter.
  67
  68 gdb_test_multiline "enum gdb parameter" \
  69     "guile" "" \
  70     "(define test-enum-param" "" \
  71     "  (make-parameter \"print test-enum-param\"" "" \
  72     "   #:command-class COMMAND_DATA" "" \
  73     "   #:parameter-type PARAM_ENUM" "" \
  74     "   #:enum-list '(\"one\" \"two\")" "" \
  75     "   #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
  76     "   #:show-doc \"Show the state of the enum.\"" "" \
  77     "   #:set-doc \"Set the state of the enum.\"" "" \
  78     "   #:show-func (lambda (self value)" "" \
  79     "      (format #f \"The state of the enum is ~a.\" value))" "" \
  80     "   #:initial-value \"one\"))" "" \
  81     "(register-parameter! test-enum-param)" "" \
  82     "end"
  83
  84 with_test_prefix "test-enum-param" {
  85     gdb_test "guile (print (parameter-value test-enum-param))" "one" "enum parameter value (one)"
  86     gdb_test "show print test-enum-param" "The state of the enum is one." "show initial value"
  87     gdb_test_no_output "set print test-enum-param two"
  88     gdb_test "show print test-enum-param" "The state of the enum is two." "show new value"
  89     gdb_test "guile (print (parameter-value test-enum-param))" "two" "enum parameter value (two)"
  90     gdb_test "set print test-enum-param three" "Undefined item: \"three\".*" "set invalid enum parameter"
  91 }
  92
  93 # Test a file parameter.
  94
  95 gdb_test_multiline "file gdb parameter" \
  96     "guile" "" \
  97     "(define test-file-param" "" \
  98     "  (make-parameter \"test-file-param\"" "" \
  99     "   #:command-class COMMAND_FILES" "" \
 100     "   #:parameter-type PARAM_FILENAME" "" \
 101     "   #:doc \"When set, test param does something useful. When disabled, does nothing.\"" "" \
 102     "   #:show-doc \"Show the name of the file.\"" "" \
 103     "   #:set-doc \"Set the name of the file.\"" "" \
 104     "   #:show-func (lambda (self value)" "" \
 105     "      (format #f \"The name of the file is ~a.\" value))" "" \
 106     "   #:initial-value \"foo.txt\"))" "" \
 107     "(register-parameter! test-file-param)" "" \
 108     "end"
 109
 110 with_test_prefix "test-file-param" {
 111     gdb_test "guile (print (parameter-value test-file-param))" "foo.txt" "initial parameter value"
 112     gdb_test "show test-file-param" "The name of the file is foo.txt." "show initial value"
 113     gdb_test_no_output "set test-file-param bar.txt"
 114     gdb_test "show test-file-param" "The name of the file is bar.txt." "show new value"
 115     gdb_test "guile (print (parameter-value test-file-param))" "bar.txt" " new parameter value"
 116     gdb_test "set test-file-param" "Argument required.*"
 117 }
 118
 119 # Test a parameter that is not documented.
 120
 121 gdb_test_multiline "undocumented gdb parameter" \
 122     "guile" "" \
 123     "(register-parameter! (make-parameter \"print test-undoc-param\"" "" \
 124     "   #:command-class COMMAND_DATA" "" \
 125     "   #:parameter-type PARAM_BOOLEAN" "" \
 126     "   #:show-func (lambda (self value)" "" \
 127     "      (format #f \"The state of the Test Parameter is ~a.\" value))" "" \
 128     "   #:initial-value #t))" "" \
 129     "end"
 130
 131 with_test_prefix "test-undocumented-param" {
 132     gdb_test "show print test-undoc-param" "The state of the Test Parameter is on." "show parameter on"
 133     gdb_test_no_output "set print test-undoc-param off"
 134     gdb_test "show print test-undoc-param" "The state of the Test Parameter is off." "show parameter off"
 135     gdb_test "help show print test-undoc-param" "This command is not documented." "show help"
 136     gdb_test "help set print test-undoc-param" "This command is not documented." "set help"
 137     gdb_test "help set print" "set print test-undoc-param -- This command is not documented.*" "general help"
 138 }
 139
 140 # Test a parameter with a restricted range, where we need to notify the user
 141 # and restore the previous value.
 142
 143 gdb_test_multiline "restricted gdb parameter" \
 144     "guile" "" \
 145     "(register-parameter! (make-parameter \"test-restricted-param\"" "" \
 146     "   #:command-class COMMAND_DATA" "" \
 147     "   #:parameter-type PARAM_ZINTEGER" "" \
 148     "   #:set-func (lambda (self)" "" \
 149     "      (let ((value (parameter-value self)))" "" \
 150     "        (if (and (>= value 0) (<= value 10))" "" \
 151     "            \"\"" "" \
 152     "            (begin" "" \
 153     "              (set-parameter-value! self (object-property self 'value))" "" \
 154     "              \"Error: Range of parameter is 0-10.\"))))" "" \
 155     "   #:show-func (lambda (self value)" "" \
 156     "      (format #f \"The value of the restricted parameter is ~a.\" value))" "" \
 157     "   #:initial-value (lambda (self)" "" \
 158     "      (set-object-property! self 'value 2)" "" \
 159     "      2)))" "" \
 160     "end"
 161
 162 with_test_prefix "test-restricted-param" {
 163     gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
 164     gdb_test_no_output "set test-restricted-param 10"
 165     gdb_test "show test-restricted-param" "The value of the restricted parameter is 10."
 166     gdb_test "set test-restricted-param 42" "Error: Range of parameter is 0-10."
 167     gdb_test "show test-restricted-param" "The value of the restricted parameter is 2."
 168 }
 169
 170 # Test registering a parameter that already exists.
 171
 172 gdb_test "guile (register-parameter! (make-parameter \"height\"))" \
 173     "ERROR.*is already defined.*" "error registering existing parameter"
 174
 175 # Test registering a parameter named with what was an ambiguous spelling
 176 # of existing parameters.
 177
 178 gdb_test_multiline "previously ambiguously named boolean parameter" \
 179     "guile" "" \
 180     "(define prev-ambig" "" \
 181     "  (make-parameter \"print s\"" "" \
 182     "   #:parameter-type PARAM_BOOLEAN))" "" \
 183     "end"
 184
 185 gdb_test_no_output "guile (register-parameter! prev-ambig)"
 186
 187 with_test_prefix "previously-ambiguous" {
 188     gdb_test "guile (print (parameter-value prev-ambig))" "= #f" "parameter value (false)"
 189     gdb_test "show print s" "Command is not documented is off." "Show parameter off"
 190     gdb_test_no_output "set print s on"
 191     gdb_test "show print s" "Command is not documented is on." "Show parameter on"
 192     gdb_test "guile (print (parameter-value prev-ambig))" "= #t" "parameter value (true)"
 193     gdb_test "help show print s" "This command is not documented." "show help"
 194     gdb_test "help set print s" "This command is not documented." "set help"
 195     gdb_test "help set print" "set print s -- This command is not documented.*" "general help"
 196 }