aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.guile/scm-gsmob.exp
diff options
context:
space:
mode:
Diffstat (limited to 'gdb/testsuite/gdb.guile/scm-gsmob.exp')
-rw-r--r--gdb/testsuite/gdb.guile/scm-gsmob.exp70
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"