# randomtest.tcl --
 #     A first shot at generating and interpreting random test cases
 #
 #     Inspired by Andreas Kupries who mentioned <http://arxiv.org/abs/cs.PL/0412012>
 #

 namespace eval ::randomtesting {
     namespace eval work {
         # Provide the working environment
     }

     namespace export randomtest

     variable error
     variable precond
 }

 # randomtest --
 #     Provide the framework for generating and interpreting random tests
 #
 # Arguments:
 #     title       Title for the test case
 #     count       Number of cases to generate
 #     code        Code to run
 #
 # Result:
 #     None
 #
 proc randomtesting::randomtest {title count code} {
     variable error
     variable precond

     set error_count 0

     for { set i 0 } { $i < $count } { incr i } {
         set error   0
         set precond 0

         #
         # TODO: Should clean the variables in "work"!
         # TODO: report the failing cases in more detail
         #
         namespace eval work $code

         incr error_count $error
     }

     if { $error_count != 0 } {
        puts "$title: $error_count failures in $count test cases"
     }
 }

 # precond --
 #     Check the preconditions - so failure can be properly dealt with,
 #     as can non-failure
 #
 # Arguments:
 #     cond        Precondition to be checked
 #
 # Result:
 #     None
 #
 proc randomtesting::work::precond {cond} {

     if { ! [uplevel [list expr $cond]] } {
         set ::randomtesting::precond 1
     }
 }

 # postcond --
 #     Check the postconditions - so results can be properly checked
 #
 # Arguments:
 #     cond        Postcondition to be checked
 #
 # Result:
 #     None
 #
 proc randomtesting::work::postcond {cond} {

     if { ! [uplevel [list expr $cond]] } {
         set ::randomtesting::error 1
     }
 }

 # run --
 #     Run the actual code under test
 #
 # Arguments:
 #     code        Code to be run
 #
 # Result:
 #     None
 #
 # Note:
 #     By allowing more than one fragment of code we could generate test
 #     cases that run multiple "methods" in any random order. This is
 #     a TODO ...
 #
 proc randomtesting::work::run {code} {

     set error [catch [list uplevel $code] msg]

     if { $error != 0 } {
         #
         # An error occurred, was this expected?
         #
         if { $::randomtesting::precond == 0 } {
             set ::randomtesting::error 1
             puts $msg
         }
     } else {
         #
         # No error occurred, was this expected?
         #
         if { $::randomtesting::precond == 1 } {
             set ::randomtesting::error 1
             puts "Code ran smoothly, despite violation of precondition"
         }
     }
 }

 # old --
 #     Return the old value of a variable
 #
 # Arguments:
 #     name        Name of the variable
 #
 # Result:
 #     Old value (before running the code under test)
 #
 # Note:
 #     This is a TODO
 #
 proc randomtesting::work::old {name} {

     error "old not implemented yet"

 }

 # randomfloat --
 #     Return a random floating-point number within a given range
 #
 # Arguments:
 #     min         Minimum value
 #     max         Maximum value
 #
 # Result:
 #     A random number within the given range
 #
 proc randomtesting::work::randomfloat {min max} {

     expr {($max-$min)*rand()+$min}
 }

 # Now a small example:
 #     addlog is supposed to add the logarithms of two numbers,
 #     so its preconditions are x > 0 and y > 0. If these are
 #     met it returns a float value.
 #

 proc addlog {x y} {
     expr {log($x*$y)} ;# More permissive than the description above!
 }

 namespace import ::randomtesting::*

 randomtest "addlog" 100 {
     set x [randomfloat -100.0 100.0]
     set y [randomfloat -100.0 100.0]

     precond { $x > 0 }
     precond { $y > 0 }

     #
     # Make sure the variable result has a value ... TODO
     set result {}
     run { set result [addlog $x $y] }

     postcond { $x <= 0.0 || $y <= 0.0 || [string is double -strict $result] }
 }