diff options
Diffstat (limited to 'gdb/testsuite/gdb.guile/scm-gsmob.exp')
-rw-r--r-- | gdb/testsuite/gdb.guile/scm-gsmob.exp | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/gdb/testsuite/gdb.guile/scm-gsmob.exp b/gdb/testsuite/gdb.guile/scm-gsmob.exp new file mode 100644 index 0000000..470afc4 --- /dev/null +++ b/gdb/testsuite/gdb.guile/scm-gsmob.exp @@ -0,0 +1,70 @@ +# Copyright (C) 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 basic gsmob features. + +load_lib gdb-guile.exp + +# Start with a fresh gdb. +gdb_exit +gdb_start + +# Skip all tests if Guile scripting is not enabled. +if { [skip_guile_tests] } { continue } + +gdb_reinitialize_dir $srcdir/$subdir + +gdb_install_guile_utils +gdb_install_guile_module + +# Test the transition from alist to htab in the property list. +# N.B. This has the same value as gdb/guile/scm-gsmob.c. +set SMOB_PROP_HTAB_THRESHOLD 7 + +gdb_test_no_output "gu (define arch (current-arch))" + +# Return a property name for integer I suitable for sorting. + +proc prop_name { i } { + return [format "prop%02d" $i] +} + +# Set and ref the properties in separate loops to verify previously set +# properties are not lost when we set a new property or switch to htabs. +for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} { + gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \ + "= #f" "property prop$i not present before set" + gdb_test_no_output "gu (set-gsmob-property! arch '[prop_name $i] $i)" \ + "set prop $i" + gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \ + "= #t" "property prop$i present after set" +} +for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} { + gdb_test "gu (print (gsmob-has-property? arch '[prop_name $i]))" \ + "= #t" "property prop$i present after all set" + gdb_test "gu (print (gsmob-property arch '[prop_name $i]))" \ + "= $i" "ref prop $i" +} + +# Verify gsmob-properties. +set prop_list "" +for {set i 0} {$i <= $SMOB_PROP_HTAB_THRESHOLD} {incr i} { + set prop_list "$prop_list [prop_name $i]" +} +set prop_list [lsort $prop_list] +verbose -log "prop_list: $prop_list" +gdb_test "gu (print (sort (gsmob-properties arch) (lambda (a b) (string<? (symbol->string a) (symbol->string b)))))" \ + "= \\($prop_list\\)" "gsmob-properties" |