doctest for Tcl

What is this?

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:

  • a full body of Tcl module can be used for doctesting
  • selected named blocks can be used for doctesting
  • several commands can produce one result to be checked
  • the results and commands can be multi-lined (continued with \)
  • the doctest blocks can contain several results to be checked
  • the block result is estimated OK if all its results are OK
  • the doctesting can be performed in safe/unsafe interpreter
  • the outputs modes are verbose, short or silent
  • only 'silent' output mode means 'hide OK, show FAILED if any'

How to do this?

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.

Tips and traps

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 (e.g. doctest.tcl below, it's used in #ARGS lines, for TKE editor). Of course, "exec" and similar commands need executing the doctest in unsafe interpreter (the Usage section below).

Also, it can be used as "a commented suite of commands". The successive #% commands form the suite with the result returned by the last command. So, the example of command31-32-33 suite above may be rewritten this way:

  ####### only result of command33 checked (command31, command32 being preparatory)
  #% command31
  ####### comments: result not checked here (even "invalid command name command31")
  #% command32
  ####### comments: result not checked here (even "invalid command name command32")
  #% command33
  #> result of command33

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.

This thing might be helpful, namely: the doctest's usage isn't restricted with a code. A data file allowing #- or multi-line comments, might include the doctest strings for testing its contents, e.g. through something like:

  #% exec tclsh module.tcl this_data_file.txt

Usage

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

Examples

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

doctest.tcl

#! /usr/bin/env tclsh
#########################################################################
#
# This utility allows a user to doctest TCL scripts and their data files.
# 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
#ARGS10: -v 1 /home/apl/PG/Tcl-Tk/projects/doctest/README.md
#
#########################################################################

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 trim [string toupper [string map {{ } _} $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]+1 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 [llength $options(cnt)]]  ;# testing all of file
    }
  } elseif {$block_begins} {
    lappend test_blocks [llength $options(cnt)]  ;# testing to the end of file
  }
  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 "[string trimright [string range $comres 0 end-1]] "
      } 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 {} -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

Links

Home page:

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:

  • doctesting the selected lines of code
  • inserting the doctest template into the code
  • menu driven
  • message boxes for results
  • hotkeys for all operations

TKE sets an example how to employ the doctest while editing Tcl modules.