gdb/testsuite/lib/trace-support.exp

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