[107883] branches/gsoc13-tests/tests/test.tcl

[marius at macports.org]

Revision: 107883
          https://trac.macports.org/changeset/107883
Author:   marius at macports.org
Date:     2013-07-08 04:27:13 -0700 (Mon, 08 Jul 2013)
Log Message:
-----------
Added color, formated output and help proc.

Modified Paths:
--------------
    branches/gsoc13-tests/tests/test.tcl

Modified: branches/gsoc13-tests/tests/test.tcl
===================================================================
--- branches/gsoc13-tests/tests/test.tcl	2013-07-08 10:55:55 UTC (rev 107882)
+++ branches/gsoc13-tests/tests/test.tcl	2013-07-08 11:27:13 UTC (rev 107883)
@@ -24,21 +24,28 @@
 
 proc print_help {arg} {
     if { $arg == "tests" } {
-        puts "test list"
+        puts "The list of abailable tests is:"
+        foreach test $::test_suite {
+            puts [puts -nonewline "  "]$test
+        }
     } else {
-        puts "help message"
+        puts "Usage: tclsh test.tcl \[-debug level\] \[-t test\] \[-l\]\n"
+        puts "  -debug LVL : sets the level of printed debug info \[0-3\]"
+        puts "  -t TEST    : run a specific test"
+        puts "  -l         : print the list of available tests"
+        puts "  -h, -help  : print this message\n"
     }
 }
 
 # Process args
 foreach arg $argv {
     if { $arg == "-h" || $arg == "-help" } {
-        print_help
+        print_help ""
         exit 0
     } elseif { $arg == "-debug" } {
         set index [expr [lsearch $argv $arg] + 1]
         set level [lindex $argv $index]
-        if { $level >= 0 && $level <= 5 } {
+        if { $level >= 0 && $level <= 3 } {
             append arguments "-debug " $level
         } else {
             puts "Invalid debug level."
@@ -57,9 +64,13 @@
             print_help tests
             exit 1
         }
-    }       
+    } elseif { $arg == "-l" } {
+        print_help tests
+        exit 0
+    }
 }
 
+
 # Run tests
 if { $test_name != ""} {
     cd test/$test_name
@@ -72,7 +83,18 @@
         cd test/$test
     
         set result [eval exec tclsh test.tcl $arguments]
-        puts $result
+        set total [lrange [split $result "\t"] 2 2]
+        set pass [lrange [split $result "\t"] 4 4]
+        set fail [lrange [split $result "\t"] 8 8]
+
+        set out ""
+        if { $fail != 0 } {
+            # Color failed tests.
+            append out "\x1b\[1;31mTotal:" $total " Passed:" $pass " Failed:" $fail "  \x1b\[0m" $test
+        } else {
+            append out "Total:" $total " Passed:" $pass " Failed:" $fail "  " $test
+        }
+        puts $out
     
         cd ../..
     }
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20130708/54786196/attachment-0001.html>