2011-11-23 16:14:51 +05:30
|
|
|
|
2012-06-30 12:13:17 +05:30
|
|
|
set env(LC_ALL) "C"
|
2011-11-23 17:18:49 +05:30
|
|
|
regexp "(.*\/)testsuite" $objdir objdir topdir
|
|
|
|
|
2012-01-02 12:09:41 +05:30
|
|
|
# These are the same as include/c.h
|
|
|
|
set usage_help "\\s*-h, --help\\s+display this help and exit\\s+"
|
|
|
|
set usage_version "\\s*-V, --version\\s+output version information and exit\\s+"
|
|
|
|
set usage_man "\\s*For more details see \\S+\\."
|
|
|
|
|
2014-07-01 14:21:21 +05:30
|
|
|
proc kill_process pid {
|
|
|
|
set cmdline "kill $pid"
|
|
|
|
if { [catch { exec /bin/sh -c $cmdline } msg]} {
|
|
|
|
warning "Could not kill process: $msg\n"
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2011-11-30 17:41:35 +05:30
|
|
|
proc procps_v_version { tool } {
|
2011-11-23 17:18:49 +05:30
|
|
|
global topdir
|
2011-11-30 17:41:35 +05:30
|
|
|
set toolpath ${topdir}${tool}
|
|
|
|
set tmp [ exec $toolpath -V ]
|
2012-01-02 12:09:41 +05:30
|
|
|
regexp "from procps-ng (\[0-9.\]*)" $tmp tmp version
|
2011-11-30 17:41:35 +05:30
|
|
|
clone_output "$toolpath version $version\n"
|
2011-11-23 17:18:49 +05:30
|
|
|
}
|
|
|
|
|
2013-03-14 19:01:03 +05:30
|
|
|
proc free_version {} { procps_v_version free }
|
|
|
|
proc kill_version {} { procps_v_version kill }
|
|
|
|
proc pgrep_version {} { procps_v_version pgrep }
|
|
|
|
proc pkill_version {} { procps_v_version pkill }
|
|
|
|
proc pmap_version {} { procps_v_version pmap }
|
|
|
|
proc pwdx_version {} { procps_v_version pwdx }
|
|
|
|
proc sysctl_version {} { procps_v_version sysctl }
|
|
|
|
proc uptime_version {} { procps_v_version uptime }
|
|
|
|
proc vmstat_version {} { procps_v_version vmstat }
|
|
|
|
proc w_version {} { procps_v_version w }
|
2011-11-23 17:18:49 +05:30
|
|
|
|
|
|
|
#
|
|
|
|
#
|
|
|
|
# common utilities
|
|
|
|
proc expect_continue { testname reg } {
|
|
|
|
expect {
|
|
|
|
-re "$reg" { }
|
|
|
|
eof { fail "$testname" }
|
|
|
|
timeout { fail "$testname" }
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
proc expect_pass { testname reg } {
|
|
|
|
expect {
|
|
|
|
-re "$reg" { pass "$testname" }
|
2011-12-01 17:12:23 +05:30
|
|
|
default { fail "$testname" }
|
2012-03-03 06:19:48 +05:30
|
|
|
timeout { fail "$testname" }
|
2011-11-23 17:18:49 +05:30
|
|
|
}
|
2011-11-23 16:14:51 +05:30
|
|
|
}
|
2011-11-27 10:00:04 +05:30
|
|
|
|
|
|
|
proc expect_blank { testname } {
|
|
|
|
expect {
|
|
|
|
-re "\\w" { fail "$testname" }
|
|
|
|
eof { pass "$testname" }
|
|
|
|
timeout { pass "$testname" }
|
|
|
|
}
|
|
|
|
}
|
2011-11-27 13:02:10 +05:30
|
|
|
|
2011-12-01 17:12:23 +05:30
|
|
|
proc expect_table { test match_header match_items match_footer } {
|
|
|
|
expect {
|
|
|
|
-re "$match_header" {
|
|
|
|
expect {
|
|
|
|
-re "$match_items" {
|
|
|
|
expect {
|
|
|
|
-re "$match_footer" { pass "$test" }
|
|
|
|
default { fail "$test (footer)" }
|
|
|
|
}
|
|
|
|
}
|
|
|
|
default { fail "$test (items)" }
|
|
|
|
}
|
|
|
|
}
|
|
|
|
default { fail "$test (header)" }
|
|
|
|
}
|
|
|
|
}
|
2013-03-14 19:01:03 +05:30
|
|
|
|
2011-12-02 17:11:03 +05:30
|
|
|
proc expect_table_dsc { test match_header match_item } {
|
|
|
|
expect {
|
|
|
|
-re $match_header {}
|
|
|
|
default {
|
|
|
|
fail "$test (header)"
|
|
|
|
return
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
set do_loop 1
|
2013-03-26 17:52:30 +05:30
|
|
|
set last_value 99999999
|
2011-12-02 17:11:03 +05:30
|
|
|
set found_item 0
|
|
|
|
while { $do_loop ==1 } {
|
|
|
|
expect {
|
|
|
|
-re $match_item {
|
|
|
|
set current_value $expect_out(1,string)
|
|
|
|
if { $current_value > $last_value } {
|
|
|
|
fail "$test (sorting $current_value > $last_value)"
|
|
|
|
return
|
|
|
|
} else {
|
|
|
|
set found_item 1
|
|
|
|
set last_value $current_value
|
|
|
|
}
|
|
|
|
}
|
|
|
|
default {
|
|
|
|
if { $found_item == 0 } {
|
|
|
|
fail "$test (items)"
|
|
|
|
} else {
|
|
|
|
pass $test
|
|
|
|
}
|
|
|
|
return
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
#expect {
|
|
|
|
# -re $match_footer { pass $test }
|
|
|
|
# default { fail "$test (footer)" }
|
|
|
|
#}
|
|
|
|
}
|
|
|
|
|
2011-11-27 13:02:10 +05:30
|
|
|
proc make_testproc { } {
|
2019-08-03 15:28:18 +05:30
|
|
|
global testproc_path testproc_comm testproc_arg_str testproc1_pid testproc2_pid topdir
|
2012-08-18 05:50:27 +05:30
|
|
|
|
2015-06-14 04:24:59 +05:30
|
|
|
set testproc_realpath "${topdir}/lib/test_process"
|
2015-06-13 10:34:31 +05:30
|
|
|
set testproc_comm "spcorp"
|
2011-11-30 17:41:35 +05:30
|
|
|
|
2011-11-27 13:02:10 +05:30
|
|
|
set testproc_path [ exec mktemp -u ]
|
2015-06-13 10:34:31 +05:30
|
|
|
exec ln -s $testproc_realpath $testproc_path
|
2011-11-30 17:41:35 +05:30
|
|
|
|
2011-11-27 13:02:10 +05:30
|
|
|
spawn readlink $testproc_path
|
|
|
|
expect {
|
2015-06-13 10:34:31 +05:30
|
|
|
-re "^$testproc_realpath\\s*$" { }
|
|
|
|
timeout { perror "test proc does not link to test process" }
|
|
|
|
eof { perror "test proc does not link to test process" }
|
2011-11-27 13:02:10 +05:30
|
|
|
}
|
2011-11-30 17:41:35 +05:30
|
|
|
|
2019-08-03 15:28:18 +05:30
|
|
|
# make a process with the argument set to a fraction of ARG_MAX length
|
|
|
|
# but small enough we do not run TCL out of memory for regular expressions
|
|
|
|
# nor do we get argument list too long (104857 was found to work on Ubuntu 18.04)
|
|
|
|
set max_arg_len [ expr min([ exec /usr/bin/getconf ARG_MAX ], 104857) ]
|
|
|
|
# ensure we have enough slack to launch the test prog and pgrep
|
|
|
|
set reserved_space [expr max([ string length $testproc_path ], [ string length $topdir ] + 10)]
|
|
|
|
set testproc_arg_str "a"
|
|
|
|
set i $reserved_space
|
|
|
|
while {$i<$max_arg_len} {
|
|
|
|
incr i
|
|
|
|
append testproc_arg_str "a"
|
|
|
|
}
|
|
|
|
set testproc1_pid [ exec $testproc_path $testproc_arg_str & ]
|
2015-06-13 10:34:31 +05:30
|
|
|
set testproc2_pid [ exec $testproc_path & ]
|
2011-11-27 13:02:10 +05:30
|
|
|
}
|
2014-07-01 14:21:21 +05:30
|
|
|
|
|
|
|
proc kill_testproc { } {
|
|
|
|
global testproc_path testproc1_pid testproc2_pid
|
|
|
|
|
|
|
|
kill_process $testproc1_pid
|
|
|
|
kill_process $testproc2_pid
|
|
|
|
file delete $testproc_path
|
|
|
|
}
|
2015-05-09 13:18:12 +05:30
|
|
|
|
|
|
|
proc get_tty {} {
|
|
|
|
if { [catch { set raw_tty [ exec tty ] } msg]} {
|
|
|
|
warning "No TTY found"
|
|
|
|
return ""
|
|
|
|
}
|
|
|
|
regexp "/dev/(.+)" $raw_tty > tty
|
|
|
|
return $tty
|
|
|
|
}
|