###############################################################################
#
# vwait.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
#
# Copyright (c) 2007-2012 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

source [file join [file normalize [file dirname [info script]]] prologue.eagle]

###############################################################################

runTest {test vwait-1.1 {vwait on new var with proc} -setup {
  proc bar {} {lappend ::test yes}
} -body {
  after 1000 [list bar]
  vwait ::test

  set ::test
} -cleanup {
  unset ::test

  rename bar ""
} -result {yes}}

###############################################################################

runTest {test vwait-1.2 {vwait on changed var with proc} -setup {
  proc bar {} {lappend ::test yes}
} -body {
  after 1000 [list bar]
  vwait ::test

  after 1000 [list bar]
  vwait ::test

  set ::test
} -cleanup {
  unset ::test

  rename bar ""
} -result {yes yes}}

###############################################################################

runTest {test vwait-1.3 {vwait on unset var with proc} -setup {
  proc bar {} {unset ::test}
} -body {
  set ::test yes

  after 1000 [list bar]
  vwait ::test

  expr {int([info exists ::test])}
} -cleanup {
  unset -nocomplain ::test

  rename bar ""
} -result {0}}

###############################################################################

#
# HACK: For now, constrain this test to run only in the Eagle Shell
#       (i.e. where we can guarantee a minimum stack size for created
#       threads).
#
runTest {test vwait-1.4 {vwait on new var with proc (threaded)} -setup {
  proc bar {} {set ::t [object create -alias Thread threadStart]; $::t Start}
  proc threadStart {} {lappend ::test yes}

  object import System.Threading
} -body {
  after 1000 [list bar]
  vwait ::test

  set ::test
} -cleanup {
  object unimport -importpattern System.Threading

  if {[info exists ::t]} then {cleanupThread $::t}

  unset -nocomplain ::t ::test

  catch {object removecallback threadStart}

  rename threadStart ""
  rename bar ""
} -constraints {eagle shell compile.THREADING} -result {yes}}

###############################################################################

#
# HACK: For now, constrain this test to run only in the Eagle Shell
#       (i.e. where we can guarantee a minimum stack size for created
#       threads).
#
runTest {test vwait-1.5 {vwait on changed var with proc (threaded)} -setup {
  proc bar {} {set ::t [object create -alias Thread threadStart]; $::t Start}
  proc threadStart {} {lappend ::test yes}

  object import System.Threading
} -body {
  after 1000 [list bar]
  vwait ::test

  after 1000 [list bar]
  vwait ::test

  set ::test
} -cleanup {
  object unimport -importpattern System.Threading

  if {[info exists ::t]} then {cleanupThread $::t}

  unset -nocomplain ::t ::test

  catch {object removecallback threadStart}

  rename threadStart ""
  rename bar ""
} -constraints {eagle shell compile.THREADING} -result {yes yes}}

###############################################################################

#
# HACK: For now, constrain this test to run only in the Eagle Shell
#       (i.e. where we can guarantee a minimum stack size for created
#       threads).
#
runTest {test vwait-1.6 {vwait on unset var with proc (threaded)} -setup {
  proc bar {} {set ::t [object create -alias Thread threadStart]; $::t Start}
  proc threadStart {} {unset ::test}

  object import System.Threading
} -body {
  set ::test yes

  after 1000 [list bar]
  vwait ::test

  expr {int([info exists ::test])}
} -cleanup {
  object unimport -importpattern System.Threading

  if {[info exists ::t]} then {cleanupThread $::t}

  unset -nocomplain ::t ::test

  catch {object removecallback threadStart}

  rename threadStart ""
  rename bar ""
} -constraints {eagle shell compile.THREADING} -result {0}}

###############################################################################

#
# HACK: For now, constrain this test to run only in the Eagle Shell
#       (i.e. where we can guarantee a minimum stack size for created
#       threads).
#
runTest {test vwait-1.7 {vwait on changes with proc (threaded)} -setup {
  proc randomSign {} {return [expr {rand() >= 0.5 ? 1 : -1}]}
  proc threadStart {} {lappend ::test yes}

  proc bar { i } {
    set ::t($i) [object create -alias Thread threadStart]; $::t($i) Start
  }

  object import System.Threading
} -body {
  set times [list]

  for {set i 0} {$i < 20} {incr i} {
    #
    # NOTE: Calculate a time based on the event index with a slight
    #       random jitter of up to 1 second.
    #
    set time [expr {int(($i * 1000) + \
        ([randomSign] * rand() * 1000))}]

    if {$time < 0} then {set time 0}

    lappend times $time
    after $time [list bar $i]
  }

  while {1} {
    #
    # NOTE: Due to various subtle timing issues (including the use of
    #       random wait times for the events) this [vwait] can raise
    #       the error: "can't wait for variable X: would wait forever".
    #       In that case, we can simply break out of the loop.  This
    #       may cause the test to fail.
    #
    if {[catch {vwait ::test}]} then {
      break
    }

    #
    # NOTE: As soon as we hit 10 elements in the test list, we break
    #       out of the loop.
    #
    if {[llength $::test] >= 10} then {
      break
    }
  }

  concat [set ::test] [set times]
} -cleanup {
  foreach i [after info] {catch {after cancel $i}}

  object unimport -importpattern System.Threading

  for {set i 0} {$i < 20} {incr i} {
    if {[info exists ::t($i)] && [cleanupThread $::t($i)]} then {
      unset ::t($i)
    }
  }

  unset -nocomplain ::t ::test times time i

  catch {object removecallback threadStart}

  rename threadStart ""
  rename bar ""
  rename randomSign ""
} -constraints {eagle shell timing compile.THREADING} -match regexp -result \
{^(?:yes ){9,11}\d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+\
\d+ \d+ \d+ \d+ \d+$}}

###############################################################################

runTest {test vwait-1.8 {after idle priority (mixed)} -setup {
  proc idleEvent { value } {
    lappend ::idleEvents [list idle $value]
  }
} -body {
  set ::idle 0

  foreach e [list 0000 1999 2000 2001 1000 1001 3000 3001 0002] {
    after idle [list idleEvent [incr ::idle]]
    after $e [list lappend ::events $e]
    after idle [list idleEvent [incr ::idle]]
  }

  after 4000 [list set ::forever true]
  vwait ::forever

  list $::events $::idleEvents $::idle $::forever
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain ::events ::idleEvents ::idle ::forever i e

  rename idleEvent ""
} -constraints {timing} -result {{0000 0002 1000 1001 1999 2000 2001 3000 3001}\
{{idle 1} {idle 2} {idle 3} {idle 4} {idle 5} {idle 6} {idle 7} {idle 8} {idle\
9} {idle 10} {idle 11} {idle 12} {idle 13} {idle 14} {idle 15} {idle 16} {idle\
17} {idle 18}} 18 true}}

###############################################################################

runTest {test vwait-1.9 {after idle priority (last)} -setup {
  proc idleEvent { value } {
    lappend ::events [list idle $value]
  }

  set interp [object invoke -alias Interpreter GetActive]
  set waitEventFlags [$interp -flags +NonPublic waitEventFlags]
  $interp -flags +NonPublic waitEventFlags {+Wait IdleIfEmpty}
} -body {
  set ::idle 0

  foreach e [list 0000 1999 2000 2001 1000 1001 3000 3001 0002] {
    after idle [list idleEvent [incr ::idle]]
    after $e [list lappend ::events $e]
    after idle [list idleEvent [incr ::idle]]
  }

  after 4000 [list set ::forever true]
  vwait ::forever

  list $::events $::idle $::forever
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}
  catch {$interp -flags +NonPublic waitEventFlags $waitEventFlags}

  unset -nocomplain ::events ::idle ::forever
  unset -nocomplain i e waitEventFlags interp

  rename idleEvent ""
} -constraints {eagle} -result {{0000 0002 1000 1001 1999 2000 2001 3000 3001\
{idle 1} {idle 2} {idle 3} {idle 4} {idle 5} {idle 6} {idle 7} {idle 8}\
{idle 9} {idle 10} {idle 11} {idle 12} {idle 13} {idle 14} {idle 15} {idle 16}\
{idle 17} {idle 18}} 18 true}}

###############################################################################

runTest {test vwait-1.10 {[info level] from [after]} -setup {
  proc proc1 {} {
    lappend ::levels [info level]
    proc2
  }

  proc proc2 {} {
    lappend ::levels [info level]
    proc3
    vwait ::done
  }

  proc proc3 {} {
    lappend ::levels [info level]
    after 1000 [list proc4]
  }

  proc proc4 {} {
    lappend ::levels [info level]
    set ::done true
  }
} -body {
  set ::done false; list [proc1] $::done $::levels
} -cleanup {
  unset -nocomplain ::levels ::done

  rename proc4 ""
  rename proc3 ""
  rename proc2 ""
  rename proc1 ""
} -result {{} true {1 2 3 1}}}

###############################################################################

runTest {test vwait-1.11 {IEventManager NowCallback property} -setup {
  unset -nocomplain ::dateTime i

  #
  # NOTE: Calculate the UTC time "exactly" one hour from now and then report.
  #
  set ::dateTime(now) [clock format [expr {[clock seconds] + 3600}] \
      -gmt true -iso]

  tputs $test_channel [appendArgs "---- simulated time is: " \
      $::dateTime(now) \n]

  #
  # NOTE: Set the event manager to use a fixed "virtual time" that is "exactly"
  #       one hour from now as the current time.
  #
  object invoke Eagle._Tests.Default TestSetDateTimeNowCallback "" \
      $::dateTime(now) 0 true
} -body {
  #
  # NOTE: After "10 seconds", this script will be evaluated.  In reality, this
  #       will happen almost immediately.
  #
  set ::dateTime(script) {
    lappend ::dateTime(pulse) 10.0
    set ::dateTime(after) [clock seconds]; # actual (i.e. "non-virtual") time.
  }

  #
  # NOTE: Normally, it would take approximately 30 seconds for all these events
  #       to be processed; however, we have changed the notion of the current
  #       time in use by the event manager to be an hour ahead of now;
  #       therefore, all these events will happen almost immediately (and in
  #       precisely the same order as they were enqueued).
  #
  set ::dateTime(before) [clock seconds]; # actual (i.e. "non-virtual") time.
  after 1000 [list lappend ::dateTime(pulse) 1.0]
  after 2000 [list lappend ::dateTime(pulse) 2.1]
  after 2000 [list lappend ::dateTime(pulse) 2.2]
  after 3000 [list lappend ::dateTime(pulse) 3.0]
  after 11000 [list lappend ::dateTime(pulse) 11.1]
  after 30000 [list lappend ::dateTime(pulse) 30.1]
  after 10000 $::dateTime(script)
  after 11000 [list lappend ::dateTime(pulse) 11.2]
  after 30000 [list lappend ::dateTime(pulse) 30.2]
  vwait ::dateTime(after)

  #
  # NOTE: Calculate and report the number of seconds that elapsed while waiting
  #       for all the enqueued events to be processed.  This should be either
  #       zero or one.
  #
  set ::dateTime(elapsed) [expr {$::dateTime(after) - $::dateTime(before)}]

  tputs $test_channel [appendArgs \
      "---- elapsed seconds: " $::dateTime(elapsed) \n]

  #
  # NOTE: The result consists of the "event Ids" and the number of elapsed
  #       seconds (in "non-virtual" time) taken to process them.
  #
  list $::dateTime(pulse) \
      [expr {$::dateTime(elapsed) >= 0 && $::dateTime(elapsed) <= 1}]
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  #
  # NOTE: Restore the default current time handling for the event manager.
  #
  object invoke Eagle._Tests.Default TestSetDateTimeNowCallback "" \
      $::dateTime(now) 0 false

  unset -nocomplain ::dateTime i
} -constraints {eagle compile.TEST\
Eagle._Tests.Default.TestSetDateTimeNowCallback} -result \
{{1.0 2.1 2.2 3.0 10.0 11.1 11.2 30.1 30.2} True}}

###############################################################################

#
# BUGBUG: As of beta 24, these tests (vwait-1.12 to vwait-1.15) could not
#         pass in Eagle because it was treating all array elements as though
#         they were sharing the same "dirty" flag (i.e. modifying one array
#         element while waiting on another one would not work correctly
#         because modifying any other element in that same array would cause
#         the [vwait] to return).
#
runTest {test vwait-1.12 {wait on set of array element} -setup {
  unset -nocomplain varray i
} -body {
  after 500 [list set varray(2) 2]
  after 1000 [list set varray(1) 1]

  vwait varray(1)

  list [info exists varray(2)] [info exists varray(1)] [info exists varray]
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {1 1 1}}

###############################################################################

runTest {test vwait-1.13 {wait on unset of array element} -setup {
  unset -nocomplain varray i
} -body {
  set varray(1) 1
  after 500 [list set varray(2) 2]
  after 1000 [list unset varray(1)]

  vwait varray(1)

  list [info exists varray(2)] [info exists varray(1)] [info exists varray]
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {1 0 1}}

###############################################################################

runTest {test vwait-1.14 {wait on element, unset array} -setup {
  unset -nocomplain varray i
} -body {
  set varray(1) 1

  after 500 [list set varray(2) 2]
  after 1000 [list unset varray]

  vwait varray(1)

  list [info exists varray(2)] [info exists varray(1)] [info exists varray]
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {0 0 0}}

###############################################################################

runTest {test vwait-1.15 {wait on element, set array} -setup {
  unset -nocomplain varray i
} -body {
  set varray(1) 1

  after 500 [list set varray(2) 2]
  after 1000 [list array set varray [list 1 2 2 3]]

  vwait varray(1)

  testArrayGet varray true
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {1 2 2 3}}

###############################################################################

runTest {test vwait-1.16 {wait on array, set element} -setup {
  unset -nocomplain varray i
} -body {
  after 1000 [list set varray(1) 2]

  vwait varray

  testArrayGet varray true
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {1 2}}

###############################################################################

runTest {test vwait-1.17 {wait on array, unset element} -setup {
  unset -nocomplain varray i
} -body {
  set varray(1) 1

  after 1000 [list unset varray(1)]

  vwait varray

  testArrayGet varray true
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {}}

###############################################################################

runTest {test vwait-1.18 {wait on array, change element} -setup {
  unset -nocomplain varray i
} -body {
  set varray(1) 1

  after 1000 [list set varray(1) 2]

  vwait varray

  testArrayGet varray true
} -cleanup {
  catch {foreach i [after info] {after cancel $i}}

  unset -nocomplain varray i
} -result {1 2}}

###############################################################################

#
# HACK: *MONO* This test does not really work correctly on Mono due to lack
#       of a working performance counter implementation; however, it can run
#       as long as the performance counter measurements themselves are simply
#       skipped (i.e. just like Tcl).
#
runTest {test vwait-1.19 {wait on mixed existent/nonexistent} -setup {
  if {[isEagle] && ![isMono]} then {
    set threshold 10.00; # 10.00% Processor Time

    set counter [object create -alias \
        System.Diagnostics.PerformanceCounter Process \
        "% Processor Time" [file rootname [file tail $bin_file]]]
  }

  proc workerProc {} {
    after 1000 [list vwait $::varName1]
    after 2000 [list set $::varName1 [clock seconds]]
    after 3000 [list getPerformance]
    after 4000 [list getPerformance]
    after 5000 [list getPerformance]
    after 6000 [list getPerformance]
    after 7000 [list getPerformance]
    after 8000 [list getPerformance]
    after 9000 [list getPerformance]
    after 10000 [list set $::varName2 [clock seconds]]
  }

  proc getPerformance {} {
    if {[isEagle] && ![isMono]} then {
      lappend ::times [expr {int([$::counter NextValue])}]
    }
  }

  proc checkPerformance {} {
    if {[isEagle] && ![isMono]} then {
      #
      # NOTE: Make sure the processor time values show up in the test
      #       log file.
      #
      tputs $::test_channel [appendArgs \
          "---- processor time values (percent): " $::times \n]

      #
      # NOTE: Check that none of the recorded processor time values
      #       exceed the given threshold.
      #
      foreach time $::times {
        if {$time > $::threshold} then {
          return 0
        }
      }

      return 1
    } else {
      #
      # HACK: There is no nice way to access performance counters in
      #       native Tcl.
      #
      return 1
    }
  }
} -body {
  #
  # NOTE: Grab a fairly unique number to help construct the name of a
  #       variable that we can be certain has never existed yet in this
  #       interpreter.
  #
  set varId [string trim [clock seconds] -]

  #
  # NOTE: Construct the variable names used for this test.
  #
  set varName1 [appendArgs existent_ $varId]
  set varName2 [appendArgs nonexistent_ $varId]

  #
  # NOTE: Make sure the "existent" variable exists now.
  #
  set $varName1 [clock seconds]

  #
  # NOTE: Show the constructed variable names in the log file.
  #
  tputs $test_channel [appendArgs "---- existent variable name is: " \
      $varName1 \n]

  tputs $test_channel [appendArgs "---- nonexistent variable name is: " \
      $varName2 \n]

  #
  # NOTE: Schedule the worker procedure to start as soon as possible
  #       once the [vwait] has started and then start it.
  #
  list [expr {int([info exists $varName1])}] \
      [expr {int([info exists $varName2])}] \
      [after 0 [list workerProc]] [vwait $varName2] [checkPerformance] \
      [expr {int([info exists $varName1])}] \
      [expr {int([info exists $varName2])}]
} -cleanup {
  rename checkPerformance ""
  rename getPerformance ""
  rename workerProc ""

  if {[info exists varName1]} then {
    unset -nocomplain $varName1
  }

  if {[info exists varName2]} then {
    unset -nocomplain $varName2
  }

  unset -nocomplain varName2 varName1 varId

  if {[isEagle] && ![isMono]} then {
    unset -nocomplain time times counter threshold
  }
} -match regexp -result {^1 0 after#\d+ \{\} 1 1 1$}}

###############################################################################

source [file join [file normalize [file dirname [info script]]] epilogue.eagle]
