# -*- tcl -*- # pt_rdeengine.test: tests for the pt::rde package. # # Copyright (c) 2009 by Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: pt_rdengine.test,v 1.2 2010/07/27 22:53:53 andreas_kupries Exp $ # ------------------------------------------------------------------------- source [file join [ file dirname [file dirname [file join [pwd] [info script]]] ] devtools testutilities.tcl] testsNeedTcl 8.5 testsNeedTcltest 2.0 support { useAccel [useTcllibC] struct/stack.tcl struct::stack TestAccelInit struct::stack use snit/snit2.tcl snit useLocal pt_pexpression.tcl pt::pe useLocal pt_astree.tcl pt::ast } testing { useAccel [useTcllibC] pt/pt_rdengine.tcl pt::rde TestAccelInit pt::rde } #---------------------------------------------------------------------- proc rde_state {r} { lappend res [list IN [$r chan]] lappend res [list CC [$r current]] lappend res [list CL [$r location]] lappend res [list LS [$r lmarked]] lappend res [list ST [expr {[$r ok] ? "ok" : "fail"}]] lappend res [list SV [$r value]] lappend res [list ER [$r error]] lappend res [list ES [$r emarked]] lappend res [list TC [$r tokens]] lappend res [list NC [dictsort [$r symbols]]] lappend res [list AR [$r asts]] lappend res [list AS [$r amarked]] return "\n [join $res "\n "]" } #---------------------------------------------------------------------- snitErrors TestAccelDo struct::stack stkimpl { TestAccelDo pt::rde rdeimpl { switch -exact -- $rdeimpl { critcl { set MY myrde proc tmWrong {m loarg n {xarg {}}} { return [tcltest::wrongNumArgs "myrde $m" $loarg $n] } proc tmTooMany {m loarg {xarg {}}} { return [tcltest::tooManyArgs "myrde $m" $loarg] } proc take {tcl critcl} { return $critcl } } tcl { set MY ::myrde proc tmWrong {m loarg n {xarg {}}} { if {$xarg == {}} {set xarg $loarg} if {$xarg != {}} {set xarg " $xarg"} incr n return [tcltest::wrongNumArgs "::pt::rde::$m" "name$xarg" $n] } proc tmTooMany {m loarg {xarg {}}} { if {$xarg == {}} {set xarg $loarg} if {$xarg != {}} {set xarg " $xarg"} return [tcltest::tooManyArgs "::pt::rde::$m" "name$xarg"] } proc take {tcl critcl} { return $tcl } } } source [localPath tests/pt_rdengine.tests] } } #---------------------------------------------------------------------- TestAccelExit pt::rde TestAccelExit struct::stack rename rde_state {} testsuiteCleanup