Neilh/test suite

pkgIndex.tcl

@@ -56,7 +56,12 @@ if { $::tcl_platform(platform) eq "java" } {
   puts stderr "WARNING"
 }
 
-package ifneeded testcl 1.0.6 [list source [file join $dir src/assert.tcl]]\n[list source [file join $dir src/it.tcl]]\n[list source [file join $dir src/on.tcl]]\n[list source [file join $dir src/onirule.tcl]]\n[list source [file join $dir src/irulehttp.tcl]]\n[list source [file join $dir src/global.tcl]]
+set files { assert.tcl it.tcl on.tcl onirule.tcl irulehttp.tcl global.tcl ip.tcl }
+set sources {}
+foreach {f} $files {
+    lappend sources [list source [file join $dir src $f]]
+}
+package ifneeded testcl 1.0.6 [join $sources "\n"]
 
 # Disable certain Tcl commands from iRules
 if { $::tcl_platform(platform) eq "java" } {

src/ip.tcl

@@ -0,0 +1,59 @@
+package provide testcl 1.0.6
+package require log
+package require ip
+
+namespace eval ::testcl::IP {
+  namespace export addr
+  # namespace export IP::client_addr
+  # namespace export IP::hops
+  # namespace export IP::idle_timeout
+  # namespace export IP::intelligence
+  # namespace export IP::local_addr
+  # namespace export IP::protocol
+  # namespace export IP::remote_addr
+  # namespace export IP::server_addr
+  # namespace export IP::stats
+  # namespace export IP::tos
+  # namespace export IP::ttl
+  # namespace export IP::version
+  # namespace export IP::reputation
+}
+
+# testcl::IP::addr --
+#
+# stub for the F5 function IP::addr - Performs comparison of IP address/subnet/supernet to IP address/subnet/supernet. or parses 4 binary bytes into an IPv4 dotted quad address
+#
+# IP::addr <addr1>[/<mask>] equals <addr2>[/<mask>]
+#
+# (Not yet implemented)
+# IP::addr parse [-swap] <binary field> [<offset>]
+# IP::addr <addr1> mask <mask>
+# IP::addr parse [-ipv6|-ipv4 [-swap]] <bytearray> [<offset>]
+#
+proc ::testcl::IP::addr { ip1 op ip2 } {
+    log::log debug "testcl::IP::addr $ip1 $op $ip2 invoked"
+    if { $op eq "equals" } {
+        set mask1 [ip::mask $ip1]
+        set mask2 [ip::mask $ip2]
+
+        if {$mask1 != ""} {
+            set masked_ip1 $ip1
+        } elseif {$mask2 != ""} {
+            set masked_ip1 $ip1/$mask2
+        } else {
+            set masked_ip1 $ip1
+        }
+
+        if {$mask2 != ""} {
+            set masked_ip2 $ip2
+        } elseif {$mask1 != ""} {
+            set masked_ip2 $ip2/$mask1
+        } else {
+            set masked_ip2 $ip2
+        }
+
+        return [ip::equal $masked_ip1 $masked_ip2]
+    } else {
+        return 0
+    }
+}

test/test_ip.tcl

@@ -0,0 +1,12 @@
+source src/ip.tcl
+source src/assert.tcl
+
+namespace import ::testcl::*
+
+# Comment out to suppress logging
+#log::lvSuppressLE info 0
+
+assertNumberEquals [::testcl::IP::addr "1.2.3.4" equals "1.2.3.4/24"] 1
+assertNumberEquals [::testcl::IP::addr "1.2.5.4" equals "1.2.3.4/24"] 0
+assertNumberEquals [::testcl::IP::addr "1.2.3.4/24" equals "1.2.3.4"] 1
+assertNumberEquals [::testcl::IP::addr "1.2.5.4/24" equals "1.2.3.4"] 0

tests.sh

@@ -1,8 +1,31 @@
 #!/bin/bash
-for f in test/test_*.tcl
-do
-    if [ 'tclsh' == "$1" ] ; then tclsh "$f";
-    elif [ 'jtcl' == "$1" ] ; then jtcl "$f";
+
+function run_test() {
+    if [ 'tclsh' == "$1" ] ; then tclsh "$2";
+    elif [ 'jtcl' == "$1" ] ; then jtcl "$2";
     else echo "Usage: ./tests.sh [jtcl|tclsh]"; exit 1;
     fi
+}
+
+failures=()
+
+for file in test/test_*.tcl
+do
+    run_test "$1" "$file"
+    if [ $? -gt 0 ] ; then
+        failures+=($file)
+    fi
 done
+
+echo "Test Summary"
+echo "============"
+if [ ${#failures[@]} -gt 0 ] ; then
+    echo ${#failures[@]} " tests failed:"
+    for failure in ${failures[@]} ; do
+        echo "    ${failure}"
+    done
+    exit ${#failures[@]}
+else
+    echo "All tests successful"
+    exit 0
+fi