###############################################################################
#
# proc.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]

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

set x [list]
for {set i 0} {$i < 1000} {incr i} {lappend x "arg$i[clock seconds]"}
unset i

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

runTest {test proc-1.1 {procedure with large formal argument list} -body {
  proc bar $x {
    return [info level [info level]]
  }

  eval bar $x
} -cleanup {
  rename bar ""
} -result "bar $x"}

unset -nocomplain x

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

runTest {test proc-1.2 {procedure with optional args} -body {
  proc bar {a {b 2}} {
    return [list $a $b [info level [info level]]]
  }

  catch {bar} error
  catch {bar 1 2 3} error2

  list [bar 1] [bar 1 2] $error $error2
} -cleanup {
  unset -nocomplain error error2
  rename bar ""
} -result {{1 2 {bar 1}} {1 2 {bar 1 2}}\
{wrong # args: should be "bar a ?b?"}\
{wrong # args: should be "bar a ?b?"}}}

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

runTest {test proc-1.3 {procedure with optional args} -body {
  proc bar {a {b 2}} {
    return [list $a $b [info level [info level]]]
  }

  catch {bar} error
  catch {bar 1 2 3} error2

  list [bar 1] [bar 1 2] $error $error2
} -cleanup {
  unset -nocomplain error error2
  rename bar ""
} -result {{1 2 {bar 1}} {1 2 {bar 1 2}}\
{wrong # args: should be "bar a ?b?"}\
{wrong # args: should be "bar a ?b?"}}}

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

runTest {test proc-1.4 {procedure with optional and variadic args} -body {
  proc bar {a {b 2} {c 3}} {
    return [list $a $b $c [info level [info level]]]
  }

  catch {bar} error
  catch {bar 1 2 3 4} error2

  list [bar 1] [bar 1 2] [bar 1 2 3] $error $error2
} -cleanup {
  unset -nocomplain error error2
  rename bar ""
} -result {{1 2 3 {bar 1}} {1 2 3 {bar 1 2}}\
{1 2 3 {bar 1 2 3}}\
{wrong # args: should be "bar a ?b? ?c?"}\
{wrong # args: should be "bar a ?b? ?c?"}}}

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

runTest {test proc-1.5.1 {procedure with optional and variadic args} -body {
  proc bar {a {b 2} {c 3} args} {
    return [list $a $b $c $args [info level [info level]]]
  }

  catch {bar} error

  list [bar 1] [bar 1 2] [bar 1 2 3] [bar 1 2 3 4] $error
} -cleanup {
  unset -nocomplain error
  rename bar ""
} -constraints {tcl tcl84} -result {{1 2 3 {} {bar 1}} {1 2 3 {} {bar 1 2}}\
{1 2 3 {} {bar 1 2 3}} {1 2 3 4 {bar 1 2 3 4}}\
{wrong # args: should be "bar a ?b? ?c? args"}}}

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

runTest {test proc-1.5.2 {procedure with optional and variadic args} -body {
  proc bar {a {b 2} {c 3} args} {
    return [list $a $b $c $args [info level [info level]]]
  }

  catch {bar} error

  list [bar 1] [bar 1 2] [bar 1 2 3] [bar 1 2 3 4] $error
} -cleanup {
  unset -nocomplain error
  rename bar ""
} -constraints {tcl85} -result {{1 2 3 {} {bar 1}} {1 2 3 {} {bar 1 2}}\
{1 2 3 {} {bar 1 2 3}} {1 2 3 4 {bar 1 2 3 4}}\
{wrong # args: should be "bar a ?b? ?c? ..."}}}

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

runTest {test proc-1.5.3 {procedure with optional and variadic args} -body {
  proc bar {a {b 2} {c 3} args} {
    return [list $a $b $c $args [info level [info level]]]
  }

  catch {bar} error

  list [bar 1] [bar 1 2] [bar 1 2 3] [bar 1 2 3 4] $error
} -cleanup {
  unset -nocomplain error
  rename bar ""
} -constraints {tcl86Feature} -result {{1 2 3 {} {bar 1}} {1 2 3 {} {bar 1 2}}\
{1 2 3 {} {bar 1 2 3}} {1 2 3 4 {bar 1 2 3 4}}\
{wrong # args: should be "bar a ?b? ?c? ?arg ...?"}}}

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

runTest {test proc-1.6 {procedure with bad optional and variadic args} -body {
  proc bar {a {b 2} args c} {
    return [list $a $b $args $c [info level [info level]]]
  }

  catch {bar} error
  catch {bar 1} error2
  catch {bar 1 2} error3
  catch {bar 1 2 3} error4

  list [bar 1 2 3 4] $error $error2 $error3 $error4
} -cleanup {
  unset -nocomplain error error2 error3 error4
  rename bar ""
} -constraints {tcl84} -result {{1 2 3 4 {bar 1 2 3 4}}\
{wrong # args: should be "bar a ?b? args c"}\
{wrong # args: should be "bar a ?b? args c"}\
{wrong # args: should be "bar a ?b? args c"}\
{wrong # args: should be "bar a ?b? args c"}}}

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

runTest {test proc-1.7 {rename procedure with leading colons} -setup {
  namespace eval ::foo {}
  proc ::foo::bar {args} { return [info level [info level]] }
} -body {
  list [foo::bar 1] [::foo::bar 2] [catch {rename ::foo::bar splog} result] \
      $result [catch {splog 3} result] $result
} -cleanup {
  catch {rename splog ""}
  catch {rename foo::bar ""}
  catch {namespace delete ::foo}

  unset -nocomplain result
} -result {{foo::bar 1} {::foo::bar 2} 0 {} 0 {splog 3}}}

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

runTest {test proc-1.8 {rename and then remove procedure} -setup {
  set id [expr {abs([clock clicks])}]
  proc [appendArgs proc $id] {args} {}
} -body {
  rename [appendArgs proc $id] [appendArgs newProc $id]
  rename [appendArgs newProc $id] ""
} -cleanup {
  unset -nocomplain id
} -result {}}

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

runTest {test proc-1.9 {redefine procedure after loading it} -setup {
  proc testProcedure { args } {
    source [file join $::test_data_path testProcs.tcl]; # real procedure
    uplevel 1 testProcedure $args
  }
} -body {
  testProcedure 1 2 3
} -cleanup {
  rename testProcedure ""
} -constraints {file_testProcs.tcl} -result {6}}

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

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