gnu/dist/gdb6/gdb/testsuite/lib/trace-support.exp

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