Skip to content

Commit

Permalink
Better detection of tcl runtime environment and better error handling.
Browse files Browse the repository at this point in the history
…Closes #24.
  • Loading branch information
Stefan Magnus Landrø authored and Stefan Magnus Landrø committed Dec 7, 2013
2 parents ce3924c + f8f826a commit 4ec49aa
Show file tree
Hide file tree
Showing 15 changed files with 157 additions and 21 deletions.
10 changes: 5 additions & 5 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ Let's say you want to test the following simple iRule found in *simple_irule.tcl

Now, create a file called *test_simple_irule.tcl* containing the following lines:

package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

# Comment in to enable logging
Expand Down Expand Up @@ -96,7 +96,7 @@ You should get a success message.
Download latest [TesTcl distribution](https://github.com/landro/TesTcl/releases) from github containing all the files (including examples) found in the project.
Unzip, and add unzipped directory to the [TCLLIBPATH](http://jtcl.kenai.com/gettingstarted.html) environment variable:

export TCLLIBPATH=whereever/TesTcl-1.0.2
export TCLLIBPATH=whereever/TesTcl-1.0.3

In order to run this example, type in the following at the command-line:

Expand Down Expand Up @@ -162,7 +162,7 @@ NB! Be carefull with using _on_ commands in _before_. If there will be another d

Using the _before_ command, *test_simple_irule.tcl* can be rewritten as:

package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

# Comment in to enable logging
Expand Down Expand Up @@ -239,7 +239,7 @@ Let's have a look at a more advanced iRule (advanced_irule.tcl):

The specs for this iRule would look like this:

package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

# Comment out to suppress logging
Expand Down Expand Up @@ -351,7 +351,7 @@ Let's have a look at a another iRule (headers_irule.tcl):

The example specs for this iRule would look like this:

package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

# Comment out to suppress logging
Expand Down
5 changes: 4 additions & 1 deletion examples.sh
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
#!/bin/bash
for f in examples/example_*.tcl
do
jtcl "$f"
if [ 'tclsh' == "$1" ] ; then tclsh "$f";
elif [ 'jtcl' == "$1" ] ; then jtcl "$f";
else echo "Usage: ./examples.sh [jtcl|tclsh]"; exit 1;
fi
done
2 changes: 1 addition & 1 deletion examples/example_irule_advanced.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

##
Expand Down
2 changes: 1 addition & 1 deletion examples/example_irule_headers.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

##
Expand Down
2 changes: 1 addition & 1 deletion examples/example_irule_simple.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package require -exact testcl 1.0.2
package require -exact testcl 1.0.3
namespace import ::testcl::*

##
Expand Down
51 changes: 49 additions & 2 deletions pkgIndex.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,56 @@
if {[namespace exists ::testcl]} {
#already loaded
return
}

if { $::tcl_platform(platform) eq "java" } {

if { [catch { expr {"abc" starts_with "a"} } errormsg ] } {
puts stderr "WARNING"
puts stderr "WARNING The jtcl-irule extension to JTcl is not loaded"
puts stderr "WARNING"
puts stderr "WARNING The following custom iRule operators will not work:"
puts stderr "WARNING - starts_with"
puts stderr "WARNING - ends_with"
puts stderr "WARNING - contains"
puts stderr "WARNING - matches_glob"
puts stderr "WARNING - matches_regex"
puts stderr "WARNING - equals"
puts stderr "WARNING - and"
puts stderr "WARNING - or"
puts stderr "WARNING - not"
puts stderr "WARNING"
puts stderr "WARNING Please check your JTcl classpath - see TesTcl documentation"
puts stderr "WARNING for installation instructions"
puts stderr "WARNING"
}

} else {
puts stderr "WARNING"
puts stderr "WARNING You're using a Tcl interpreter that doesn't support the jtcl-irule extension"
puts stderr "WARNING which requires the java based JTcl interpreter"
puts stderr "WARNING"
puts stderr "WARNING The following custom iRule operators will not work:"
puts stderr "WARNING - starts_with"
puts stderr "WARNING - ends_with"
puts stderr "WARNING - contains"
puts stderr "WARNING - matches_glob"
puts stderr "WARNING - matches_regex"
puts stderr "WARNING - equals"
puts stderr "WARNING - and"
puts stderr "WARNING - or"
puts stderr "WARNING - not"
puts stderr "WARNING"
puts stderr "WARNING If you require any of these operators, you'll have to use JTcl instead"
puts stderr "WARNING Please see TesTcl documentation"
puts stderr "WARNING"
}

package ifneeded testcl 1.0.2 [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]]
package ifneeded testcl 1.0.3 [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]]

# Disable certain Tcl commands from iRules
source [file join $dir src/disabled_commands.tcl]
if { $::tcl_platform(platform) eq "java" } {
source [file join $dir src/disabled_commands_jtcl.tcl]
} else {
source [file join $dir src/disabled_commands_tclsh.tcl]
}
2 changes: 1 addition & 1 deletion src/assert.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package provide testcl 1.0.2
package provide testcl 1.0.3
package require log

namespace eval ::testcl {
Expand Down
File renamed without changes.
85 changes: 85 additions & 0 deletions src/disabled_commands_tclsh.tcl
Original file line number Diff line number Diff line change
@@ -0,0 +1,85 @@
# The following web-page documents which Tcl commands are disabled in iRules
# https://devcentral.f5.com/wiki/iRules.DisabledTclCommands.ashx

proc saferename {from to} {
if {[info procs $from] eq $from || [info commands $from] eq $from} {
rename $from $to
}
}

# Consider disabling if running old version
# after (enabled in 10.x)
# saferename after ::tcl::after

# Commands not found in tclsh
################################################


# Commnands used by tclsh internally
################################################

#saferename dict ::tcl::dict
#saferename exit ::tcl::exit
#saferename file ::tcl::file
#saferename interp ::tcl::interp

# Commands used by TesTcl
################################################

#saferename namespace ::tcl::namespace
#saferename package ::tcl::package
#saferename proc ::tcl::proc
#saferename source ::tcl::source
#saferename unknown ::tcl::unknown
#saferename rename ::tcl::rename

# Commands used by log package
################################################

#saferename flush ::tcl::flush

# Disabled commands
################################################

saferename auto_execok ::tcl::auto_execok
saferename auto_import ::tcl::auto_import
saferename auto_load ::tcl::auto_load
saferename auto_qualify ::tcl::auto_qualify
saferename cd ::tcl::cd
saferename close ::tcl::close
saferename eof ::tcl::eof
saferename encoding ::tcl::encoding
saferename exec ::tcl::exec
saferename fblocked ::tcl::fblocked
saferename fconfigure ::tcl::fconfigure
saferename fcopy ::tcl::fcopy
saferename fileevent ::tcl::fileevent
saferename gets ::tcl::gets
saferename glob ::tcl::glob
saferename lrepeat ::tcl::lrepeat
saferename lreverse ::tcl::lreverse
saferename open ::tcl::open
saferename pid ::tcl::pid
saferename pwd ::tcl::pwd
saferename seek ::tcl::seek
saferename socket ::tcl::socket
saferename tell ::tcl::tell
saferename time ::tcl::time
saferename update ::tcl::update
saferename uplevel ::tcl::uplevel
saferename upvar ::tcl::upvar
saferename vwait ::tcl::vwait

saferename auto_mkindex ::tcl::auto_mkindex
saferename auto_mkindex_old ::tcl::auto_mkindex_old
saferename auto_reset ::tcl::auto_reset
saferename bgerror ::tcl::bgerror
saferename http ::tcl::http
saferename load ::tcl::load
saferename memory ::tcl::memory
saferename pkg::create ::tcl::pkg::create
saferename pkg_mkIndex ::tcl::pkg_mkIndex
saferename tcl_findLibrary ::tcl::tcl_findLibrary
saferename filename ::tcl::filename

rename saferename {}
2 changes: 1 addition & 1 deletion src/irulehttp.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package provide testcl 1.0.2
package provide testcl 1.0.3
package require log

package require base64
Expand Down
2 changes: 1 addition & 1 deletion src/it.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package provide testcl 1.0.2
package provide testcl 1.0.3
package require log

namespace eval ::testcl {
Expand Down
2 changes: 1 addition & 1 deletion src/on.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package provide testcl 1.0.2
package provide testcl 1.0.3
package require log

namespace eval ::testcl {
Expand Down
2 changes: 1 addition & 1 deletion src/onirule.tcl
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
package provide testcl 1.0.2
package provide testcl 1.0.3
package require log

namespace eval ::testcl {
Expand Down
5 changes: 4 additions & 1 deletion tests.sh
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
#!/bin/bash
for f in test/test_*.tcl
do
jtcl "$f"
if [ 'tclsh' == "$1" ] ; then tclsh "$f";
elif [ 'jtcl' == "$1" ] ; then jtcl "$f";
else echo "Usage: ./tests.sh [jtcl|tclsh]"; exit 1;
fi
done
6 changes: 2 additions & 4 deletions verification/test_jtcl_irule_all.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,6 @@ if {"abcdefg" matches_glob "ab*efg"} { puts "matches_glob works as expected" }
if {"abcdefg" matches_regex "a.cde.*"} { puts "matches_regex works as expected" }

if {"abcdefg" equals "abcdefg"} { puts "equals works as expected" }
if { 1 and 1} { puts "and works as expected" }
if { 1 or 0} { puts "or works as expected" }
if { 1 and 1 } { puts "and works as expected" }
if { 1 or 0 } { puts "or works as expected" }
if { not false } { puts "not works as expected" }


0 comments on commit 4ec49aa

Please sign in to comment.