1 1.1.1.5 christos # Copyright (C) 2008-2020 Free Software Foundation, Inc. 2 1.1 christos 3 1.1 christos # This program is free software; you can redistribute it and/or modify 4 1.1 christos # it under the terms of the GNU General Public License as published by 5 1.1 christos # the Free Software Foundation; either version 3 of the License, or 6 1.1 christos # (at your option) any later version. 7 1.1 christos # 8 1.1 christos # This program is distributed in the hope that it will be useful, 9 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of 10 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11 1.1 christos # GNU General Public License for more details. 12 1.1 christos # 13 1.1 christos # You should have received a copy of the GNU General Public License 14 1.1 christos # along with this program. If not, see <http://www.gnu.org/licenses/>. 15 1.1 christos 16 1.1 christos # This file is part of the GDB testsuite. 17 1.1 christos # It tests basic Guile features. 18 1.1 christos 19 1.1 christos load_lib gdb-guile.exp 20 1.1 christos 21 1.1 christos # Start with a fresh gdb. 22 1.1 christos gdb_exit 23 1.1 christos gdb_start 24 1.1 christos gdb_reinitialize_dir $srcdir/$subdir 25 1.1 christos 26 1.1 christos # Do this instead of the skip_guile_check. 27 1.1 christos # We want to do some tests when Guile is not present. 28 1.1 christos gdb_test_multiple "guile (display 23) (newline)" "verify guile support" { 29 1.1 christos -re "Undefined command.*$gdb_prompt $" { 30 1.1.1.3 christos unsupported "guile not supported." 31 1.1 christos return 32 1.1 christos } 33 1.1 christos -re "not supported.*$gdb_prompt $" { 34 1.1 christos unsupported "guile support is disabled" 35 1.1 christos 36 1.1 christos # If Guile is not supported, verify that sourcing a guile script 37 1.1 christos # causes an error. 38 1.1 christos gdb_test "source $srcdir/$subdir/source2.scm" \ 39 1.1 christos "Error in sourced command file:.*" \ 40 1.1 christos "source source2.scm when guile disabled" 41 1.1 christos 42 1.1 christos # Verify multi-line guile commands cause an error. 43 1.1 christos gdb_test_multiline "multi-line guile command" \ 44 1.1 christos "guile" "" \ 45 1.1 christos "(print 23)" "" \ 46 1.1 christos "end" "not supported.*" 47 1.1 christos 48 1.1 christos return 49 1.1 christos } 50 1.1 christos -re "$gdb_prompt $" {} 51 1.1 christos } 52 1.1 christos 53 1.1 christos gdb_install_guile_utils 54 1.1 christos gdb_install_guile_module 55 1.1 christos 56 1.1 christos gdb_test_multiline "multi-line guile command" \ 57 1.1 christos "guile" "" \ 58 1.1 christos "(print 23)" "" \ 59 1.1 christos "end" "= 23" 60 1.1 christos 61 1.1 christos gdb_test_multiline "show guile command" \ 62 1.1 christos "define zzq" "Type commands for definition of .* just \"end\"\\.*" \ 63 1.1 christos "guile" "" \ 64 1.1 christos "(print 23)" "" \ 65 1.1 christos "end" "" \ 66 1.1 christos "end" "" \ 67 1.1 christos "show user zzq" "User command \"zzq\":.* guile.*\\(print 23\\).* end" 68 1.1 christos 69 1.1 christos gdb_test "source $srcdir/$subdir/source2.scm" "yes" "source source2.scm" 70 1.1 christos 71 1.1.1.5 christos gdb_test "source -s source2.scm" "yes" 72 1.1 christos 73 1.1 christos gdb_test "guile (print (current-objfile))" "= #f" 74 1.1 christos gdb_test "guile (print (objfiles))" "= \\(\\)" 75 1.1 christos 76 1.1 christos gdb_test_no_output \ 77 1.1 christos {guile (define x (execute "printf \"%d\", 23" #:to-string #t))} 78 1.1 christos gdb_test "guile (print x)" "= 23" 79 1.1 christos 80 1.1 christos gdb_test_no_output "guile (define a (execute \"help\" #:to-string #t))" \ 81 1.1 christos "collect help from uiout" 82 1.1 christos 83 1.1.1.5 christos gdb_test "guile (print a)" "= .*aliases -- User-defined aliases of other commands.*" \ 84 1.1 christos "verify help to uiout" 85