**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. 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.


**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.
  # 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


**Links**


The archive of doctest.tcl, readme.md (still disposed to update):

    * http://aplsimple.ucoz.ru/misc/doctest.rar

Tcl Equivalents of Python Modules:

    * https://wiki.tcl-lang.org/page/Tcl+Equivalents+of+Python+Modules

TKE editor (written in Tcl/Tk, tremendous tool for Tclers):

    * https://sourceforge.net/projects/tke/

https://sourceforge.net/projects/tke/%|%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

https://sourceforge.net/projects/tke/%|%TKE%|% sets an example how to employ the doctest while editing Tcl modules.