| 1 | # step.exp -- Expect script to test gdb with step.c |
| 2 | # Copyright (C) 1992, 1997, 2007-2012 Free Software Foundation, Inc. |
| 3 | |
| 4 | # This program is free software; you can redistribute it and/or modify |
| 5 | # it under the terms of the GNU General Public License as published by |
| 6 | # the Free Software Foundation; either version 3 of the License, or |
| 7 | # (at your option) any later version. |
| 8 | # |
| 9 | # This program is distributed in the hope that it will be useful, |
| 10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 12 | # GNU General Public License for more details. |
| 13 | # |
| 14 | # You should have received a copy of the GNU General Public License |
| 15 | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| 16 | |
| 17 | # This file was written by Hiro Sugawara. (hiro@lynx.com) |
| 18 | # |
| 19 | # This test really needs some major surgery to be acceptable, but |
| 20 | # I'm just about burnt out on lynx work, so I'm not doing it now. |
| 21 | # |
| 22 | # * The test has an indeterminate number of pass/fails |
| 23 | # for each run (it runs a small group of tests until |
| 24 | # it's timer kicks off). This is very bad for nightly |
| 25 | # automated regression testing. |
| 26 | # |
| 27 | # * It tries to "step" from withint he prologue of a |
| 28 | # function. This isn't support in gdb (it's going |
| 29 | # to act like a continue). |
| 30 | # |
| 31 | # * This test rarely check that it stopped in sensible |
| 32 | # places. (see previous bullet -- this test doesn't |
| 33 | # catch the fact it continued rather than stepped) |
| 34 | |
| 35 | |
| 36 | if $tracelevel then { |
| 37 | strace $tracelevel |
| 38 | } |
| 39 | |
| 40 | set program_exited 0 |
| 41 | |
| 42 | proc set_bp { where } { |
| 43 | global gdb_prompt |
| 44 | |
| 45 | send_gdb "break $where\n" |
| 46 | # The first regexp is what we get with -g, the second without -g. |
| 47 | gdb_expect { |
| 48 | -re "Break.* at .*: file .*, line \[0-9\]*.*$gdb_prompt $" {} |
| 49 | -re "Breakpoint \[0-9\]* at 0x\[0-9a-f\]*.*$gdb_prompt $" {} |
| 50 | -re "$gdb_prompt $" { fail "setting breakpoint at $where" ; return 0 } |
| 51 | timeout { fail "setting breakpoint at $where (timeout)" ; return 0 } |
| 52 | } |
| 53 | pass "set_bp" |
| 54 | } |
| 55 | |
| 56 | proc step_it { cmd } { |
| 57 | global gdb_prompt |
| 58 | global program_exited |
| 59 | global inferior_exited_re |
| 60 | |
| 61 | send_gdb "$cmd\n" |
| 62 | gdb_expect { |
| 63 | -re "0x\[0-9A-Fa-f\]* *in.*\r\n$gdb_prompt $" { pass "step_it"; return 0 } |
| 64 | -re "0x\[0-9A-Fa-f\]* *\[0-9\]*.*\r\n$gdb_prompt $" { pass "step_it"; return 1 } |
| 65 | -re "$inferior_exited_re .*\n$gdb_prompt $" { |
| 66 | set program_exited 1 |
| 67 | return -1 |
| 68 | } |
| 69 | -re "$gdb_prompt $" { fail "single-stepping ($cmd).\n" ; return -1 } |
| 70 | timeout { fail "single-stepping ($cmd) timout.\n" ; return -1 } |
| 71 | } |
| 72 | } |
| 73 | |
| 74 | proc step_inst {} { |
| 75 | step_it "stepi" |
| 76 | } |
| 77 | |
| 78 | proc step_source {} { |
| 79 | step_it "step" |
| 80 | } |
| 81 | |
| 82 | proc continue_all {} { |
| 83 | global gdb_prompt |
| 84 | global inferior_exited_re |
| 85 | |
| 86 | send_gdb "continue\n" |
| 87 | gdb_expect { |
| 88 | -re "Breakpoint \[0-9\]*, thread\[0-9\]* .*$gdb_prompt $" { |
| 89 | pass "continue_all" |
| 90 | return 0 |
| 91 | } |
| 92 | -re "$inferior_exited_re .*\n$gdb_prompt $" { |
| 93 | set program_exited 1 |
| 94 | return 1; |
| 95 | } |
| 96 | -re "$gdb_prompt $" { fail "continue" ; return -1 } |
| 97 | timeout { fail "continue (timeout)" ; return -1 } |
| 98 | } |
| 99 | } |
| 100 | |
| 101 | proc check_threads { num_threads } { |
| 102 | global gdb_prompt |
| 103 | |
| 104 | set curr_thread 0 |
| 105 | send_gdb "info threads\n" |
| 106 | while { $num_threads > 0 } { |
| 107 | gdb_expect { |
| 108 | -re "\\* *\[0-9\]* process \[0-9\]* thread \[0-9\]* .*\n" { |
| 109 | incr curr_thread |
| 110 | set num_threads [expr $num_threads - 1] |
| 111 | } |
| 112 | -re " *\[0-9\]* process \[0-9\]* thread \[0-9\]* .*\n" { |
| 113 | set num_threads [expr $num_threads - 1] |
| 114 | } |
| 115 | -re "$gdb_prompt $" { |
| 116 | if { $num_threads < 0 } { |
| 117 | fail "check_threads (too many)" ; return -1 |
| 118 | } |
| 119 | break |
| 120 | } |
| 121 | timeout { fail "check_threads (timeout)" ; return -1 } |
| 122 | } |
| 123 | } |
| 124 | |
| 125 | if { $curr_thread == 0 } { |
| 126 | fail "check_threads (no current thread)\n" |
| 127 | return -1 |
| 128 | } |
| 129 | if { $curr_thread > 1 } { |
| 130 | fail "check_threads (more than one current thread)\n" |
| 131 | return -1 |
| 132 | } |
| 133 | return 0 |
| 134 | } |
| 135 | |
| 136 | proc test_cond_wait {} { |
| 137 | global program_exited |
| 138 | |
| 139 | set_bp 135 |
| 140 | runto 179 |
| 141 | while { 1 } { |
| 142 | set stepi_counter 0 |
| 143 | while { [step_inst] } { |
| 144 | if { $program_exited } { break } |
| 145 | incr stepi_counter |
| 146 | if { $stepi_counter > 30 } { |
| 147 | fail "too many stepi's per line\n" |
| 148 | return -1 |
| 149 | } |
| 150 | } |
| 151 | if { $program_exited } { break } |
| 152 | step_source |
| 153 | if { $program_exited } { break } |
| 154 | continue_all |
| 155 | if { $program_exited } { break } |
| 156 | check_threads 3 |
| 157 | } |
| 158 | } |
| 159 | |
| 160 | proc do_tests {} { |
| 161 | global subdir |
| 162 | global objdir |
| 163 | global srcdir |
| 164 | global binfile |
| 165 | global gdb_prompt |
| 166 | |
| 167 | |
| 168 | # Start with a fresh gdb. |
| 169 | |
| 170 | gdb_exit |
| 171 | gdb_start |
| 172 | gdb_reinitialize_dir $srcdir/$subdir |
| 173 | gdb_load $objdir/$subdir/$binfile |
| 174 | |
| 175 | send_gdb "set width 0\n" |
| 176 | gdb_expect -re "$gdb_prompt $" |
| 177 | |
| 178 | test_cond_wait |
| 179 | } |
| 180 | |
| 181 | # Check to see if we have an executable to test. If not, then either we |
| 182 | # haven't tried to compile one, or the compilation failed for some reason. |
| 183 | # In either case, just notify the user and skip the tests in this file. |
| 184 | |
| 185 | set binfile "step" |
| 186 | set srcfile "step.c" |
| 187 | |
| 188 | if ![file exists $objdir/$subdir/$binfile] then { |
| 189 | if $all_flag then { |
| 190 | warning "$binfile does not exist; tests suppressed." |
| 191 | } |
| 192 | } else { |
| 193 | do_tests |
| 194 | } |