gdb/testsuite/lib/emc-support.exp

   1 proc gdb_emc_readvar { varname } {
   2     global gdb_prompt;
   3
   4     set result -1;
   5     send_gdb "print $varname\n"
   6     gdb_expect 5 {
   7         -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" {
   8             set result $expect_out(1,string);
   9         }
  10         -re "$gdb_prompt $" { }
  11         default { }
  12     }
  13     return $result;
  14 }
  15
  16 proc gdb_emc_gettpnum { testname } {
  17     global gdb_prompt;
  18
  19     if { $testname != "" } {
  20         gdb_test "trace $testname" "" ""
  21     }
  22     return [gdb_emc_readvar "\$tpnum"];
  23 }
  24
  25 proc gdb_emc_setactions { testname actionname args } {
  26     global gdb_prompt;
  27
  28     set state 0;
  29     set status "pass";
  30     send_gdb "actions $actionname\n";
  31     set expected_result "";
  32     gdb_expect 5 {
  33         -re "No tracepoint number .*$gdb_prompt $" {
  34             fail $testname
  35             return 1;
  36         }
  37         -re "Enter actions for tracepoint $actionname.*>" {
  38             if { [llength $args] > 0 } {
  39                 set lastcommand "[lindex $args $state]";
  40                 send_gdb "[lindex $args $state]\n";
  41                 incr state;
  42                 set expected_result [lindex $args $state];
  43                 incr state;
  44             } else {
  45                 send_gdb "end\n";
  46             }
  47             exp_continue;
  48         }
  49         -re "\(.*\[\r\n\]+)\[ \t]*> $" {
  50             if { $expected_result != "" } {
  51                 # Remove echoed command and its associated newline.
  52                 regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out;
  53                 # Strip off any newlines at the end of the string.
  54                 regsub "\[\r\n\]+$" "$out" "" out;
  55                 verbose "expected '$expected_result', got '$out', expect_out is '$expect_out(1,string)'";
  56                 if ![regexp $expected_result $out] {
  57                     set status "fail";
  58                 }
  59                 set expected_result "";
  60             }
  61             if { $state < [llength $args] } {
  62                 send_gdb "[lindex $args $state]\n";
  63                 incr state;
  64                 set expected_result [lindex $args $state];
  65                 incr state;
  66             } else {
  67                 send_gdb "end\n";
  68                 set expected_result "";
  69             }
  70             exp_continue;
  71         }
  72         -re "\(.*\)$gdb_prompt $" {
  73             if { $expected_result != "" } {
  74                 if ![regexp $expected_result $expect_out(1,string)] {
  75                     set status "fail";
  76                 }
  77                 set expected_result "";
  78             }
  79             if { [llength $args] < $state } {
  80                 set status "fail";
  81             }
  82         }
  83         default {
  84             set status "fail";
  85         }
  86     }
  87     if { $testname != "" } {
  88         $status $testname;
  89     }
  90     if { $status == "pass" } then {
  91         return 0;
  92     } else {
  93         return 1;
  94     }
  95 }
  96
  97 #
  98 # test collect command
  99 #
 100
 101 proc gdb_emc_tracetest_collect { arg1 msgstring } {
 102     global decimal
 103     global gdb_prompt;
 104
 105     set teststate 0
 106     gdb_expect 30 {
 107         -re "Enter actions for tracepoint $decimal.*> $" {
 108             send_gdb "collect $arg1\n"
 109             incr teststate;
 110             exp_continue
 111         }
 112         -re "> $" {
 113             if { $teststate == 1 } {
 114                 send_gdb "end\n"
 115                 incr teststate;
 116                 exp_continue
 117             } else {
 118                 fail "$msgstring"
 119             }
 120         }
 121         -re ".*$gdb_prompt $" {
 122             if { $teststate == 2 } {
 123                 pass "$msgstring";
 124             } else {
 125                 fail "$msgstring";
 126             }
 127         }
 128         default {
 129             fail "$msgstring (default)";
 130         }
 131     }
 132     regsub -all "(\[($@*+)\])" "collect $arg1" "\[\\1\]" arg1_regexp;
 133     gdb_test "info tracepoints" ".*$arg1_regexp.*" "$msgstring info tracepoint"
 134 }
 135
 136 proc gdb_delete_tracepoints { } {
 137     global gdb_prompt;
 138
 139     send_gdb "delete tracepoints\n"
 140     gdb_expect 30 {
 141         -re "Delete all tracepoints.*y or n.*$" {
 142             send_gdb "y\n"
 143             exp_continue;
 144         }
 145         -re "$gdb_prompt $" { }
 146         timeout { fail "delete all tracepoints (timeout)" }
 147     }
 148 }
 149
 150
 151 # Send each command in the list CMDLIST to gdb. If we see the string
 152 # "error" or "warning" from gdb, we assume an error has occured and
 153 # return a non-zero result. All of the commands in CMDLIST are always
 154 # sent, even if an error occurs.
 155 # If TESTNAME is non-null, we call pass or fail with the string in TESTNAME
 156 # depending on whether or not an error/warning has occurred.
 157 #
 158 proc gdb_do_cmdlist { cmdlist testname } {
 159     global gdb_prompt;
 160
 161     set status 0;
 162
 163     foreach x $cmdlist {
 164         send_gdb "$x\n";
 165         gdb_expect 60 {
 166             -re "\[Ee\]rror|\[Ww\]arning" {
 167                 set status 1;
 168                 exp_continue;
 169             }
 170             -re "$gdb_prompt $" { }
 171             -re "\[\r\n\]\[ \t\]*> *$" { }
 172         }
 173     }
 174     if { $testname != "" } {
 175         if { $status == 0 } {
 176             pass "$testname";
 177         } else {
 178             fail "$testname";
 179         }
 180     }
 181     return $status;
 182 }
 183
 184 #
 185 # Given the file FILENAME, we read it as a list of commands and generate
 186 # a list suitable for use by gdb_do_cmdlist. Lines beginning with # are
 187 # ignored; blank lines are interpreted as empty lines to be sent to gdb.
 188 #
 189 proc gdb_process_cmdfile { filename } {
 190     set id [open $filename "r"];
 191     if { $id < 0 } {
 192         return "";
 193     }
 194     set result {};
 195     while { [gets $id line] >= 0 } {
 196         if [regexp "^#" $line] {
 197             continue;
 198         }
 199         set result [concat $result [list "$line"]];
 200     }
 201     close $id;
 202     return $result;
 203 }
 204
 205 # gdb_find_c_test_baseline
 206 # returns -1 on failure (CALLER MUST CHECK RETURN!)
 207 proc gdb_find_c_test_baseline { } {
 208     global gdb_prompt;
 209
 210     set gdb_c_test_baseline -1;
 211
 212     send_gdb "list gdb_c_test\n"
 213     gdb_expect {
 214         -re "void.*p5,.*void.*p6.*\[\r\n\](\[0-9\]+)\[\t \]+\{.*$gdb_prompt $" {
 215             set gdb_c_test_baseline $expect_out(1,string)
 216         }
 217         -re "$gdb_prompt $" { }
 218         default { }
 219     }
 220     return $gdb_c_test_baseline;
 221 }
 222
 223