This allows a user to doctest Tcl scripts.
To say shortly, the doctests are special comments inserted directly into a Tcl code. The doctest blocks are closely related to the code of module and used for testing and documenting it. You run this doctest on them and get the results of testing (OK or FAILED). Just so simple.
This allows you to keep your code in a working state each time you modify it.
The features of this doctest:
The test blocks include the test examples concerning the current script and are quoted with the following doctest-begin and doctest-end Tcl comments:
#% doctest ... (tested code) ... #> doctest
The commands of ... (tested code) ... are marked with #% and are followed with their results that are marked with #>. For example:
# these two lines are a command and its result #% somecommand #> "result of somecommand"
So, we place the commands and their results between doctest quotes. Let us see how to do it:
#% doctest (put here any title/name/number/comment) ############ here we have two commands and their waited results ############ (note how a command/result begins and ends) #% command1 #> result of command1 #% command2 #> result of command2 ############ command33 needs command31, command32 to be run before ############ (their results are ignored if not raising exceptions): #% command31 #% command32 #% command33 #> result of command33 ############ command4 returns a multiline result ############ (in particular, you should use this when the test raises ############ an exception so that you copy-paste it as the waited result) #% command4 #> 1st line of result of command4 #> 2nd line of result of command4 #> 3rd line of result of command4 ############ command may be continued with "\" as its last character. #% command-so-loooooong - begin \ #% command-so-loooooong - cont. \ #% command-so-loooooong - cont. \ #% command-so-loooooong - end #> result of command-so-loooooong #> doctest
You can have as many test blocks as you need. If there are no doctest quotes, all of the text is considered as a giant test block containing #% and #> lines to be tested.
The block is tested OK when all its test cases (#% through #>) result in OK. The whole doctest is considered OK when all its blocks result in OK.
Do not include into the test blocks the commands that cannot be run outside of their context (calls of external procedures etc.).
The most fit to doctest are the procedures with more or less complex and error-prone algorithms of pure computing. The typical though trivial example is factorial (its example below).
Note: This doctest was tested under Linux (Debian) and Windows. All bug fixes and corrections for other platforms would be appreciated.
PLEASE, NOTICE AGAIN: Do not include into the test blocks the commands that cannot be run or are unavailable (calls of external procedures etc.).
If the whole of module should be spanned for doctesting, do not use #% doctest quotes. Use only docstrings (#% command, %> result) at that.
If the last #% doctest quote isn't paired with lower #> doctest quote, the test block continues to the end of text.
The middle unpaired #% doctest and the unpaired #> doctest are considered as errors making the test impossible.
Results of commands are checked literally, though the starting and tailing spaces of #% and #> lines are ignored.
If a command's result should contain starting/tailing spaces, it should be quoted with double quotes. The following someformat command
#% someformat 123 #> " 123"
should return
" 123"
for the test to be OK.
The following two tests are identical and both return the empty string:
#% set _ "" ;# test #1 #> "" #% set _ "" ;# test #2 #>
The absence of resulting #> means that a result isn't important (e.g. for GUI tests) and no messages are displayed in non-verbose doctest. In such cases the & might be useful at the end of command:
#% exec wish ./GUImodule.tcl arg1 arg2 & # ------ no result is waited here ------
This mode may be useful when applied inside an editor/IDE. In doctest.tcl below, it's shown in #ARGS lines.
Of course, "exec" and similar commands need executing the doctest in unsafe interpreter (the Usage section below).
The successive #% commands form the suite with the result returned by the last command (the example of command31-32-33 suite above).
A tested command can throw an exception considered as its normal result under some conditions (the example of factorial proc below).
You can run the doctest on this text to see how it works.
To run the doctest, use the command:
tclsh doctest.tcl ?options? filename
where:
filename - path to Tcl source file
options:
-s 1 | 0 - safe (default) | unsafe execution
-v 1 | 0 | -1 - verbose (default) | short | silent mode
-b block - name of block to be tested
-- - switches options off (for filename)The -b option may be repeated. If -b omitted, all of the file is checked for the doctest blocks to execute.
Examples:
tclsh doctest.tcl ~/PG/projects/pave/paveme.tcl tclsh doctest.tcl -v -1 ~/PG/projects/pave/paveme.tcl tclsh doctest.tcl -s 0 -b 1 -b 2 ~/PG/projects/pave/paveme.tcl tclsh doctest.tcl ~/PG/projects/doctest/README.md tclsh doctest.tcl -b factorial ~/PG/projects/doctest/README.md
Though being trivial, the factorial procedure should check some conditions to return a proper result.
#% doctest factorial
############## Calculate factorial of integer N (1 * 2 * 3 * ... * N)
proc factorial {i} {
if {$i<0} { ;# btw checks if i is a number
throw {ARITH {factorial expects a positive integer}} \
"expected positive integer but got \"$i\""
}
if {"$i" eq "0" || "$i" eq "1"} {return 1}
return [expr {$i * [factorial [incr i -1]]}] ;# btw checks if i is integer
}
#% factorial 0
#> 1
#% factorial 1
#> 1
#% factorial 10
#> 3628800
#% factorial 50
#> 30414093201713378043612608166064768844377641568960512000000000000
#
# (:=test for test:=)
#% expr 1*2*3*4*5*6*7*8*9*10*11*12*13*14*15*16*17*18*19*20* \
#% 21*22*23*24*25*26*27*28*29*30*31*32*33*34*35*36*37*38*39*40* \
#% 41*42*43*44*45*46*47*48*49*50
#> 30414093201713378043612608166064768844377641568960512000000000000
#% expr [factorial 50] == \
#% 1*2*3*4*5*6*7*8*9*10*11*12*13*14*15*16*17*18*19*20* \
#% 21*22*23*24*25*26*27*28*29*30*31*32*33*34*35*36*37*38*39*40* \
#% 41*42*43*44*45*46*47*48*49*50
#> 1
# (:=do not try factorial 1000, nevermore, the raven croaked:=)
#
#% factorial 1.1
#> expected integer but got "1.1"
#% factorial 0.1
#> expected integer but got "0.1"
#% factorial -1
#> expected positive integer but got "-1"
#% factorial -1.1
#> expected positive integer but got "-1.1"
#% factorial abc
#> expected integer but got "abc"
#% factorial
#> wrong # args: should be "factorial i"
#> doctest
Another example could make you smile:
#% doctest 1
#% set a "123 \\\\\\\\ 45"
#% eval append b {*}$a ;# guten Appetit
#> 123\45
#> doctest
#! /usr/bin/env tclsh
#########################################################################
#
# This utility allows a user to doctest TCL scripts.
# See README.md for details.
#
#########################################################################
#
# Test cases for TKE e_menu plugin.
# #ARGS<N>: means arguments for 'Run me' menu item.
# First case without "-" will be run:
#
#-ARGS0: /home/apl/PG/Tcl-Tk/projects/pave/paveme.tcl
#-ARGS1: -s 1 -v 1 /home/apl/PG/Tcl-Tk/projects/pave/paveme.tcl
#-ARGS2: -s 0 -v 1 -b 2 /home/apl/PG/Tcl-Tk/projects/pave/paveme.tcl
#-ARGS3: -s 0 -v -1 -b 2 /home/apl/PG/Tcl-Tk/projects/pave/paveme.tcl
#-ARGS4: -s 0 -v 1 -b 2 -b 1 /home/apl/PG/Tcl-Tk/projects/pave/paveme.tcl
#-ARGS5: -v 0 /home/apl/TKE-clone/TKE-clone/plugins/doctest/README.md
#-ARGS6: -v -1 /home/apl/TKE-clone/TKE-clone/plugins/doctest/README.md
#-ARGS7: -v 1 /home/apl/TKE-clone/TKE-clone/plugins/doctest/README.md
#-ARGS8: -v 1 -b factorial /home/apl/PG/Tcl-Tk/projects/doctest/README.md
#ARGS9: -v 0 -s 0 /home/apl/TKE-clone/TKE-clone/plugins/e_menu/e_menu/e_menu.tcl
#
#########################################################################
namespace eval doctest {
variable SYNOPSIS "This is used for doctesting Tcl code.
Usage:
tclsh doctest.tcl ?options? filename
where
filename - path to Tcl source file
options:
-s 1 | 0 - safe (default) | unsafe execution
-v 1 | 0 | -1 - verbose (default) | short | silent mode
-b block - name of block to be tested
-- - switches options off (for filename)
The -b option may be repeated. If -b
omitted, all of the file is checked
for the doctest blocks to execute.
See README.md for details."
variable TEST "doctest"
variable TEST_BEGIN "#% $TEST"
variable TEST_END "#> $TEST"
variable TEST_COMMAND "#%"
variable TEST_RESULT "#>"
variable NOTHING "\nNo\nNo"
variable ntestedany
variable UNDER \n[string repeat "=" 60]
variable HINT1 "
Make the doctest blocks as
$doctest::TEST_BEGIN ?name-of-block?
...
#% tested-command
\[#% tested-command\]
#> output of tested-command
\[#> output of tested-command\]
...
$doctest::TEST_END
See details in README.md"
variable options
}
###################################################################
# Show info message, e.g.: MES "Info title" $st == $BL_END \n\n ...
proc doctest::MES {title args} {
puts "\n $title:"
foreach ls $args {
puts ""
foreach l [split $ls \n] {
puts " $l"
}
}
}
proc doctest::ERR {args} { MES ERROR {*}$args }
###################################################################
# Get line stripped of spaces and uppercased
proc doctest::strip_upcase {st} {
return [string toupper [string map {" " ""} [string trim $st]]]
}
###################################################################
# Make string of args (1 2 3 ... be string of "1 2 3 ...")
proc doctest::string_of_args {args} {
set msg ""; foreach m $args {set msg "$msg $m"}
return [string trim $msg " \{\}"]
}
###################################################################
# Show synopsis and exit
proc doctest::exit_on_error { {ams ""}} {
variable SYNOPSIS
variable UNDER
MES SYNOPSIS $SYNOPSIS $UNDER $ams
exit
}
###################################################################
# Get line's contents
proc doctest::get_line_contents {ind} {
variable options
return [lindex $options(cnt) [incr ind -1]]
}
###################################################################
# Get test blocks (TEST_BEGIN ... TEST_END)
proc doctest::get_test_block {begin end} {
set block ""
for {set i $begin} {$i<=$end} {incr i} {
append block [get_line_contents $i] "\n"
}
return $block
}
proc doctest::get_test_blocks {} {
variable BL_BEGIN
variable BL_END
variable options
set test_blocks [list]
set block_begins 0
set ind 0
set doit 0
foreach st $options(cnt) {
incr ind
set st [strip_upcase $st]
if {[string first $BL_BEGIN $st]==0} {
set blk [string trimright " [string range $st [string len $BL_BEGIN] end]"]
if {$block_begins} {
return [list 1 [list]] ;# unpaired begins
}
set tname \n[string toupper [string range $st [string len $BL_BEGIN] end]]\n
set doit [expr {$options(-b)=="" || [string first $tname $options(-b)]>=0}]
if {$doit} {
lappend test_blocks [expr {$ind + 1}] ;# begin of block
set block_begins 1
}
} elseif {$st == $BL_END && $doit} {
if {!$block_begins} {
return [list 2 [list]] ;# unpaired ends
}
lappend test_blocks [expr {$ind - 1}] $blk ;# end of block
set block_begins 0
}
}
if {![llength $test_blocks]} {
if {$options(-b)==""} {
set test_blocks [list 1 $options(len)]
}
} elseif {$block_begins} {
lappend test_blocks $options(len) ;# end of block
}
return [list 0 $test_blocks]
}
###################################################################
# Get line of command or command's waited result
proc doctest::get_line {type i} {
variable NOTHING
set st [string trimleft [get_line_contents $i]]
if {[set i [string first $type $st]] == 0} {
return [string range $st [expr {[string length $type]+1}] end]
}
return $NOTHING
}
###################################################################
# Get command/result lines
# Input:
# - type - type of line (COMMAND or RESULT)
# - i1 - starting line to process
# - i2 - ending line to process
# Returns:
# - command/result lines
# - next line to process
proc doctest::get_com_res {type i1 i2} {
variable TEST
variable NOTHING
variable TEST_COMMAND
set comres $NOTHING
for {set i $i1; set res ""} {$i <= $i2} {incr i} {
set line [string trim [get_line $type $i] " "]
if {[string index $line 0] eq "\"" && [string index $line end] eq "\""} {
set line [string range $line 1 end-1]
}
if {[string first $TEST $line]==0} {
continue ;# this may occur when block is selection
}
if {$line == $NOTHING} {
break
} else {
if {$comres==$NOTHING} {
set comres ""
}
if {$type eq $TEST_COMMAND && [string index $comres end] eq "\\"} {
set comres "$comres "
} elseif {$comres != ""} {
set comres "$comres\n"
}
set comres "$comres$line"
}
}
return [list $comres $i]
}
###################################################################
# Get commands' results
proc doctest::get_commands {i1 i2} {
variable TEST_COMMAND
return [get_com_res $TEST_COMMAND $i1 $i2]
}
###################################################################
# Get waited results
proc doctest::get_results {i1 i2} {
variable TEST_RESULT
return [get_com_res $TEST_RESULT $i1 $i2]
}
###################################################################
# Execute commands and compare their results to waited ones
proc doctest::execute_and_check {block safe commands results} {
set err ""
set ok 0
if {[catch {
if {$safe} {
set tmpi [interp create -safe]
} else {
set tmpi [interp create]
}
set res [interp eval $tmpi $block\n$commands]
interp delete $tmpi
if {$res eq $results} {
set ok 1
}
} e]
} {
if {$e eq $results} {
set ok 1
}
set res $e
}
return [list $ok $res]
}
###################################################################
# Test block of commands and their results
proc doctest::test_block {begin end blk safe verbose} {
variable UNDER
variable options
variable NOTHING
variable ntestedany
set block_ok -1
set block [get_test_block $begin $end]
set i1 $begin
set i2 $end
for {set i $i1} {$i <= $i2} {} {
lassign [get_commands $i $i2] commands i ;# get commands
if {$commands != "" && $commands != $NOTHING} {
lassign [get_results $i $i2] results i ;# get waited results
lassign [execute_and_check $block $safe $commands $results] ok res
if {$results==$NOTHING} {
# no result waited, for GUI tests
set ok true
set res ""
} else {
incr ntestedany
}
set coms "% $commands\n\n"
if {$ok} {
if {$verbose==1} {
MES "DOCTEST$blk" "${coms}> $res\n\nOK$UNDER"
}
if {$block_ok==-1} {set block_ok 1}
} else {
if {$verbose==1} {
MES "ERROR OF DOCTEST$blk" "${coms}GOT:\n\"$res\"
\nWAITED:\n\"$results\"
\nFAILED$UNDER"
}
set block_ok 0
}
} else {
incr i
}
}
return $block_ok
}
proc doctest::test_blocks {blocks safe verbose} {
variable HINT1
variable UNDER
variable ntestedany
set all_ok -1
set ptested [set ntested [set ntestedany 0]]
foreach {begin end blk} $blocks {
set block_ok [test_block $begin $end $blk $safe $verbose]
if {$block_ok!=-1} {
if {$block_ok} {
incr ptested
} else {
incr ntested
}
if {$block_ok==1 && $all_ok==-1} {
set all_ok 1
} elseif {$block_ok==0} {
set all_ok 0
}
}
}
if {($ptested + $ntested)==0} {
ERR "Nothing to test.$HINT1"
} elseif {(!$verbose || ($verbose==-1 && !$all_ok)) && $ntestedany} {
if {$all_ok} {
MES "DOCTEST" " Tested ${ptested} block(s)\n\nOK$UNDER"
} else {
MES "ERROR OF DOCTEST" " Failed ${ntested} block(s)\n\nFAILED$UNDER"
}
}
}
###################################################################
# Get text of file and options
proc doctest::init {args} {
variable options
array set options {fn "" cnt {} len 0 -s 1 -v 1 -b {}}
if {[llength $args] == 0} exit_on_error
set off 0
foreach {opt val} $args {
if {$off} {
append options(fn) " $opt $val"
continue
}
switch -glob $opt {
-s - -v { set options($opt) $val }
-b { set options($opt) "$options($opt) \n[strip_upcase $val]\n " }
-- { set off 1 }
default {
append options(fn) " $opt $val"
}
}
}
if {[lsearch {1 0} $options(-s)]==-1 || \
[lsearch {1 0 -1} $options(-v)]==-1} {
exit_on_error
}
set options(fn) [string trim $options(fn)]
if {[catch {set ch [open $options(fn)]}]} {
exit_on_error "\"$options(fn)\" not open"
}
set options(cnt) [split [read $ch] \n]
close $ch
}
###################################################################
# Perform doctest
proc doctest::do {} {
variable TEST_BEGIN
variable TEST_END
variable HINT1
variable BL_BEGIN [strip_upcase $TEST_BEGIN]
variable BL_END [strip_upcase $TEST_END]
variable options
lassign [get_test_blocks] error blocks
switch $error {
0 { test_blocks $blocks $options(-s) $options(-v)}
1 { ERR "Unpaired: $TEST_BEGIN$HINT1" }
2 { ERR "Unpaired: $TEST_END$HINT1" }
}
}
#####################################################################
# main program huh
doctest::init {*}$::argv
doctest::do
The archive of doctest.tcl, readme.md (still disposed to update):
Tcl Equivalents of Python Modules:
TKE editor (written in Tcl/Tk, tremendous tool for Tclers):
TKE editor has its own doctest plugin that provides the additional facilities:
TKE sets an example how to employ the doctest while editing Tcl modules.