diff --git a/examples/example_irule_variables.tcl b/examples/example_irule_variables.tcl new file mode 100644 index 0000000..be73a58 --- /dev/null +++ b/examples/example_irule_variables.tcl @@ -0,0 +1,38 @@ +package require -exact testcl 1.0.10 +namespace import ::testcl::* + +## +# Example demonstrating how to use TesTcl +# This is how you should write your tests +# +# To run example +# +# export TCLLIBPATH=/parent/dir/of/this/file +# +# and run the following command from /parent/dir/of/this/file +# +# jtcl examples/example_irule_variables.tcl +# +## + +# Comment out to suppress logging +#log::lvSuppressLE info 0 + +before { + event HTTP_REQUEST +} + +it "should set pool to foo when status is 1" { + endstate pool foo + array set variables { status 1 } + run irules/variables_irule.tcl simple variables +} + +it "should set pool to bar when status is 0" { + endstate pool bar + array set variables { status 0 } + run irules/variables_irule.tcl simple variables +} + + +stats diff --git a/irules/variables_irule.tcl b/irules/variables_irule.tcl new file mode 100644 index 0000000..ca8b7e3 --- /dev/null +++ b/irules/variables_irule.tcl @@ -0,0 +1,11 @@ +rule simple { + + when HTTP_REQUEST priority 100 { + # set variable outside irule + if { $status eq 1 } { + pool foo + } else { + pool bar + } + } +} diff --git a/src/onirule.tcl b/src/onirule.tcl index 078f00f..5e12800 100644 --- a/src/onirule.tcl +++ b/src/onirule.tcl @@ -3,6 +3,7 @@ package require log namespace eval ::testcl { variable expectedEvent + variable variables namespace export rule namespace export when namespace export event @@ -65,6 +66,13 @@ proc ::testcl::when args { set body [lindex $args end] } + variable variables + if [ info exists variables ] { + foreach { key value } [ array get variables ] { + uplevel 0 {set $key $value} + } + } + variable expectedEvent if {[info exists expectedEvent] && $event eq $expectedEvent} { @@ -150,8 +158,11 @@ proc ::testcl::event {event_type} { # # Results: # none -proc ::testcl::run {irule rulename} { +proc ::testcl::run {irule rulename {vars {}}} { log::log info "Running irule $irule" + variable variables + upvar 1 $vars a + array set variables [array get a] set rc [catch {source $irule} result] if { 0 != $rc } { log::log error "Running irule $irule failed: $result" diff --git a/test/test_irule_variables.tcl b/test/test_irule_variables.tcl new file mode 100644 index 0000000..600ebbe --- /dev/null +++ b/test/test_irule_variables.tcl @@ -0,0 +1,16 @@ +source src/on.tcl +source src/assert.tcl +source src/onirule.tcl +namespace import ::testcl::* + +# Comment out to suppress logging +#log::lvSuppressLE info 0 + +event HTTP_REQUEST + +on pool bar return "" + +endstate pool foo + +array set variables { status 1 } +run irules/variables_irule.tcl simple variables