<pre style='margin:0'>
Rainer Müller (raimue) pushed a commit to branch master
in repository macports-base.
</pre>
<p><a href="https://github.com/macports/macports-base/commit/afe6052fa3ef081aeb31989cb6ee21b1d818fc3d">https://github.com/macports/macports-base/commit/afe6052fa3ef081aeb31989cb6ee21b1d818fc3d</a></p>
<pre style="white-space: pre; background: #F8F8F8"><span style='display:block; white-space:pre;color:#808000;'>commit afe6052fa3ef081aeb31989cb6ee21b1d818fc3d
</span>Author: Rainer Müller <raimue@macports.org>
AuthorDate: Sun Apr 15 16:52:30 2018 +0200
<span style='display:block; white-space:pre;color:#404040;'> pextlib: Add tests for system command
</span>---
src/pextlib1.0/Makefile.in | 1 +
src/pextlib1.0/tests/system.tcl | 79 +++++++++++++++++++++++++++++++++++++++++
2 files changed, 80 insertions(+)
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/pextlib1.0/Makefile.in b/src/pextlib1.0/Makefile.in
</span><span style='display:block; white-space:pre;color:#808080;'>index f9cbe62..b260080 100644
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>--- a/src/pextlib1.0/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/pextlib1.0/Makefile.in
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -68,6 +68,7 @@ test:: ${SHLIB_NAME}
</span> ${TCLSH} $(srcdir)/tests/filemap.tcl ./${SHLIB_NAME}
${TCLSH} $(srcdir)/tests/fs-traverse.tcl ./${SHLIB_NAME}
${TCLSH} $(srcdir)/tests/symlink.tcl ./${SHLIB_NAME}
<span style='display:block; white-space:pre;background:#e0ffe0;'>+ ${TCLSH} $(srcdir)/tests/system.tcl ./${SHLIB_NAME}
</span> ${TCLSH} $(srcdir)/tests/unsetenv.tcl ./${SHLIB_NAME}
${TCLSH} $(srcdir)/tests/vercomp.tcl ./${SHLIB_NAME}
<span style='display:block; white-space:pre;color:#808080;'>diff --git a/src/pextlib1.0/tests/system.tcl b/src/pextlib1.0/tests/system.tcl
</span>new file mode 100644
<span style='display:block; white-space:pre;color:#808080;'>index 0000000..7a3b2fc
</span><span style='display:block; white-space:pre;background:#ffe0e0;'>--- /dev/null
</span><span style='display:block; white-space:pre;background:#e0e0ff;'>+++ b/src/pextlib1.0/tests/system.tcl
</span><span style='display:block; white-space:pre;background:#e0e0e0;'>@@ -0,0 +1,79 @@
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Test file for Pextlib's system command.
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# Syntax:
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# tclsh system.tcl <Pextlib name>
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# globals
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+set output ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+set failures 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# stubs
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc ui_debug {args} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ # ignored
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc ui_info {args} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global output
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append output "$args\n"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# helper
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc check {a b} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$a ne $b} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ return $b
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# run system command
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+# test_system {cmd...} {vars} {body...}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc test_system {args} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global output failures
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set vars [lindex $args end-1]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set body "proc body {$vars} { global output; "
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append body [lindex $args end] "}; body"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ foreach var $vars {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append body " \$$var"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set args [lreplace $args end-1 end]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set cmd "system "
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ append cmd $args
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set output ""
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {[catch {uplevel $cmd} res]} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "FAILED: $cmd"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "catch: $res"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr failures
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ } else {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set output [string trim $output]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set res [uplevel $body]
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$res ne ""} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "FAILED: $cmd"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Output: $output"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ puts "Expected: $res"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ incr failures
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+proc main {pextlibname} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ global output failures
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ load $pextlibname
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ set str "MacPortsTest"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ test_system "echo \"$str\"" {str} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ check [string trim $output] $str
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ test_system -W /usr "pwd" {} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ check [string trim $output] "/usr"
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ if {$failures > 0} {
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ exit 1
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ }
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+ exit 0
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+}
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+
</span><span style='display:block; white-space:pre;background:#e0ffe0;'>+main $argv
</span></pre><pre style='margin:0'>
</pre>