gdb/testsuite/lib/trace-support.exp

   1 # Copyright (C) 1998, 2007, 2008 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 # Please email any bugs, comments, and/or additions to this file to:
  17 # bug-gdb@prep.ai.mit.edu
  18
  19
  20 #
  21 # Support procedures for trace testing
  22 #
  23
  24
  25 #
  26 # Procedure: gdb_target_supports_trace
  27 # Returns true if GDB is connected to a target that supports tracing.
  28 # Allows tests to abort early if not running on a trace-aware target.
  29 #
  30
  31 proc gdb_target_supports_trace { } {
  32     global gdb_prompt
  33
  34     send_gdb "tstatus\n"
  35     gdb_expect {
  36         -re "\[Tt\]race can only be run on.*$gdb_prompt $" {
  37             return 0
  38         }
  39         -re "\[Tt\]race can not be run on.*$gdb_prompt $" {
  40             return 0
  41         }
  42         -re "\[Tt\]arget does not support.*$gdb_prompt $" {
  43             return 0
  44         }
  45         -re ".*\[Ee\]rror.*$gdb_prompt $" {
  46             return 0
  47         }
  48         -re ".*\[Ww\]arning.*$gdb_prompt $" {
  49             return 0
  50         }
  51         -re ".*$gdb_prompt $" {
  52             return 1
  53         }
  54         timeout {
  55             return 0
  56         }
  57     }
  58 }
  59
  60
  61 #
  62 # Procedure: gdb_delete_tracepoints
  63 # Many of the tests depend on setting tracepoints at various places and
  64 # running until that tracepoint is reached.  At times, we want to start
  65 # with a clean slate with respect to tracepoints, so this utility proc
  66 # lets us do this without duplicating this code everywhere.
  67 #
  68
  69 proc gdb_delete_tracepoints {} {
  70     global gdb_prompt
  71
  72     send_gdb "delete tracepoints\n"
  73     gdb_expect 30 {
  74         -re "Delete all tracepoints.*y or n.*$" {
  75             send_gdb "y\n";
  76             exp_continue
  77         }
  78         -re ".*$gdb_prompt $" { # This happens if there were no tracepoints }
  79         timeout {
  80             perror "Delete all tracepoints in delete_tracepoints (timeout)"
  81             return
  82         }
  83     }
  84     send_gdb "info tracepoints\n"
  85     gdb_expect 30 {
  86          -re "No tracepoints.*$gdb_prompt $" {}
  87          -re "$gdb_prompt $" { perror "tracepoints not deleted" ; return }
  88          timeout { perror "info tracepoints (timeout)" ; return }
  89     }
  90 }
  91
  92 #
  93 # Procedure: gdb_trace_setactions
  94 #   Define actions for a tracepoint.
  95 #   Arguments:
  96 #       testname   -- identifying string for pass/fail output
  97 #       tracepoint -- to which tracepoint do these actions apply? (optional)
  98 #       args       -- list of actions to be defined.
  99 #   Returns:
 100 #       zero       -- success
 101 #       non-zero   -- failure
 102
 103 proc gdb_trace_setactions { testname tracepoint args } {
 104     global gdb_prompt;
 105
 106     set state 0;
 107     set passfail "pass";
 108     send_gdb "actions $tracepoint\n";
 109     set expected_result "";
 110     gdb_expect 5 {
 111         -re "No tracepoint number .*$gdb_prompt $" {
 112             fail $testname
 113             return 1;
 114         }
 115         -re "Enter actions for tracepoint $tracepoint.*>" {
 116             if { [llength $args] > 0 } {
 117                 set lastcommand "[lindex $args $state]";
 118                 send_gdb "[lindex $args $state]\n";
 119                 incr state;
 120                 set expected_result [lindex $args $state];
 121                 incr state;
 122             } else {
 123                 send_gdb "end\n";
 124             }
 125             exp_continue;
 126         }
 127         -re "\(.*\)\[\r\n\]+\[ \t]*> $" {
 128             if { $expected_result != "" } {
 129                 regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out;
 130                 if ![regexp $expected_result $out] {
 131                     set passfail "fail";
 132                 }
 133                 set expected_result "";
 134             }
 135             if { $state < [llength $args] } {
 136                 send_gdb "[lindex $args $state]\n";
 137                 incr state;
 138                 set expected_result [lindex $args $state];
 139                 incr state;
 140             } else {
 141                 send_gdb "end\n";
 142                 set expected_result "";
 143             }
 144             exp_continue;
 145         }
 146         -re "\(.*\)$gdb_prompt $" {
 147             if { $expected_result != "" } {
 148                 if ![regexp $expected_result $expect_out(1,string)] {
 149                     set passfail "fail";
 150                 }
 151                 set expected_result "";
 152             }
 153             if { [llength $args] < $state } {
 154                 set passfail "fail";
 155             }
 156         }
 157         default {
 158             set passfail "fail";
 159         }
 160     }
 161     if { $testname != "" } {
 162         $passfail $testname;
 163     }
 164     if { $passfail == "pass" } then {
 165         return 0;
 166     } else {
 167         return 1;
 168     }
 169 }
 170
 171 #
 172 # Procedure: gdb_tfind_test
 173 #   Find a specified trace frame.
 174 #   Arguments:
 175 #       testname   -- identifying string for pass/fail output
 176 #       tfind_arg  -- frame (line, PC, etc.) identifier
 177 #       exp_res    -- Expected result of frame test
 178 #       args       -- Test expression
 179 #   Returns:
 180 #       zero       -- success
 181 #       non-zero   -- failure
 182 #
 183
 184 proc gdb_tfind_test { testname tfind_arg exp_res args } {
 185     global gdb_prompt;
 186
 187     if { "$args" != "" } {
 188         set expr "$exp_res";
 189         set exp_res "$args";
 190     } else {
 191         set expr "(int) \$trace_frame";
 192     }
 193     set passfail "fail";
 194
 195     gdb_test "tfind $tfind_arg" "" ""
 196     send_gdb "printf \"x \%d x\\n\", $expr\n";
 197     gdb_expect 10 {
 198         -re "x (-*\[0-9\]+) x" {
 199             if { $expect_out(1,string) == $exp_res } {
 200                 set passfail "pass";
 201             }
 202             exp_continue;
 203         }
 204         -re "$gdb_prompt $" { }
 205     }
 206     $passfail "$testname";
 207     if { $passfail == "pass" } then {
 208         return 0;
 209     } else {
 210         return 1;
 211     }
 212 }
 213
 214 #
 215 # Procedure: gdb_readexpr
 216 #   Arguments:
 217 #       gdb_expr    -- the expression whose value is desired
 218 #   Returns:
 219 #       the value of gdb_expr, as evaluated by gdb.
 220 #       [FIXME: returns -1 on error, which is sometimes a legit value]
 221 #
 222
 223 proc gdb_readexpr { gdb_expr } {
 224     global gdb_prompt;
 225
 226     set result -1;
 227     send_gdb "print $gdb_expr\n"
 228     gdb_expect 5 {
 229         -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" {
 230             set result $expect_out(1,string);
 231         }
 232         -re "$gdb_prompt $" { }
 233         default { }
 234     }
 235     return $result;
 236 }
 237
 238 #
 239 # Procedure: gdb_gettpnum
 240 #   Arguments:
 241 #       tracepoint (optional): if supplied, set a tracepoint here.
 242 #   Returns:
 243 #       the tracepoint ID of the most recently set tracepoint.
 244 #
 245
 246 proc gdb_gettpnum { tracepoint } {
 247     global gdb_prompt;
 248
 249     if { $tracepoint != "" } {
 250         gdb_test "trace $tracepoint" "" ""
 251     }
 252     return [gdb_readexpr "\$tpnum"];
 253 }
 254
 255
 256 #
 257 # Procedure: gdb_find_function_baseline
 258 #   Arguments:
 259 #       func_name -- name of source function
 260 #   Returns:
 261 #       Sourcefile line of function definition (open curly brace),
 262 #       or -1 on failure.  Caller must check return value.
 263 #   Note:
 264 #       Works only for open curly brace at beginning of source line!
 265 #
 266
 267 proc gdb_find_function_baseline { func_name } {
 268     global gdb_prompt;
 269
 270     set baseline -1;
 271
 272     send_gdb "list $func_name\n"
 273 #    gdb_expect {
 274 #       -re "\[\r\n\]\[\{\].*$gdb_prompt $" {
 275 #           set baseline 1
 276 #        }
 277 #    }
 278 }
 279
 280 #
 281 # Procedure: gdb_find_function_baseline
 282 #   Arguments:
 283 #       filename: name of source file of desired function.
 284 #   Returns:
 285 #       Sourcefile line of function definition (open curly brace),
 286 #       or -1 on failure.  Caller must check return value.
 287 #   Note:
 288 #       Works only for open curly brace at beginning of source line!
 289 #
 290
 291 proc gdb_find_recursion_test_baseline { filename } {
 292     global gdb_prompt;
 293
 294     set baseline -1;
 295
 296     gdb_test "list $filename:1" "" ""
 297     send_gdb "search gdb_recursion_test line 0\n"
 298     gdb_expect {
 299         -re "(\[0-9\]+)\[\t \]+\{.*line 0.*$gdb_prompt $" {
 300             set baseline $expect_out(1,string);
 301         }
 302         -re "$gdb_prompt $" { }
 303         default { }
 304     }
 305     return $baseline;
 306 }