# -*- tcl -*- # doctools.test: tests for the doctools package. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2003 by Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: doctools.test,v 1.2 2003/03/05 06:50:33 andreas_kupries Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } package require doctools puts "doctools [package present doctools]" namespace import ::doctools::new # search paths ............................................................. test doctools-1.0 {default search paths} { llength $::doctools::paths } 1 test doctools-1.1 {extend package search paths} { ::doctools::search [file dirname [info script]] set res [list] lappend res [llength $::doctools::paths] lappend res [lindex $::doctools::paths 0] set res } [list 2 [file dirname [info script]]] test doctools-1.2 {extend package search paths, error} { catch {::doctools::search foo} result set result } {doctools::search: path does not exist} # format help ............................................................. test doctools-2.0 {format help} { string length [doctools::help] } 2055 # doctools ............................................................. test doctools-3.0 {doctools errors} { catch {new} msg set msg } [tcltest::getErrorMessage "new" "name args" 0] test doctools-3.1 {doctools errors} { catch {new set} msg set msg } "command \"set\" already exists, unable to create doctools object" test doctools-3.2 {doctools errors} { new mydoctools catch {new mydoctools} msg mydoctools destroy set msg } "command \"mydoctools\" already exists, unable to create doctools object" test doctools-3.3 {doctools errors} { catch {new mydoctools -foo} msg set msg } {wrong # args: doctools::new name ?opt val...??} # doctools methods ...................................................... test doctools-4.0 {doctools method errors} { new mydoctools catch {mydoctools} msg mydoctools destroy set msg } "wrong # args: should be \"mydoctools option ?arg arg ...?\"" test doctools-4.1 {doctools errors} { new mydoctools catch {mydoctools foo} msg mydoctools destroy set msg } "bad option \"foo\": must be cget, configure, destroy, format, map, search, warnings, parameters, or setparam" # cget .................................................................. test doctools-5.0 {cget errors} { new mydoctools catch {mydoctools cget} result mydoctools destroy set result } [tcltest::getErrorMessage "::doctools::_cget" "name option" 1] test doctools-5.1 {cget errors} { new mydoctools catch {mydoctools cget foo bar} result mydoctools destroy set result } [tcltest::tooManyMessage "::doctools::_cget" "name option"] test doctools-5.2 {cget errors} { new mydoctools catch {mydoctools cget -foo} result mydoctools destroy set result } {doctools::_configure: Unknown option "-foo", expected -copyright, -file, -module, -format, or -deprecated} foreach {na nb option default newvalue} { 3 4 -deprecated 0 1 5 6 -file {} foo 7 8 -module {} bar 9 10 -format {} latex 11 12 -copyright {} {Andreas Kupries} } { test doctools-5.$na {cget query} { new mydoctools set res [mydoctools cget $option] mydoctools destroy set res } $default ; # {} test doctools-5.$nb {cget set & query} { new mydoctools mydoctools configure $option $newvalue set res [mydoctools cget $option] mydoctools destroy set res } $newvalue ; # {} } # configure .................................................................. test doctools-6.0 {configure errors} { new mydoctools catch {mydoctools configure -foo bar -glub} result mydoctools destroy set result } {wrong # args: doctools::_configure name ?opt val...??} # [tcltest::getErrorMessage "::doctools::_configure" "name ?option?|?option value...?" 1] test doctools-6.1 {configure errors} { new mydoctools catch {mydoctools configure -foo} result mydoctools destroy set result } {doctools::_configure: Unknown option "-foo", expected -copyright, -file, -module, -format, or -deprecated} test doctools-6.2 {configure retrieval} { new mydoctools catch {mydoctools configure} result mydoctools destroy set result } {-file {} -module {} -format {} -copyright {} -deprecated 0} foreach {n option illegalvalue result} { 3 -deprecated foo {doctools::_configure: -deprecated expected a boolean, got "foo"} 4 -format barf {doctools::_configure: -format: Unknown format "barf"} } { test doctools-6.$n {configure illegal value} { new mydoctools catch {mydoctools configure $option $illegalvalue} result mydoctools destroy set result } $result } foreach {na nb option default newvalue} { 5 6 -deprecated 0 1 7 8 -file {} foo 9 10 -module {} bar 11 12 -format {} latex 13 14 -copyright {} {Andreas Kupries} } { test doctools-6.$na {configure query} { new mydoctools set res [mydoctools configure $option] mydoctools destroy set res } $default ; # {} test doctools-6.$nb {configure set & query} { new mydoctools mydoctools configure $option $newvalue set res [mydoctools configure $option] mydoctools destroy set res } $newvalue ; # {} } test doctools-6.13 {configure full retrieval} { new mydoctools -file foo -module bar -format latex -deprecated 1 -copyright gnarf catch {mydoctools configure} result mydoctools destroy set result } {-file foo -module bar -format latex -copyright gnarf -deprecated 1} # search .................................................................. test doctools-7.0 {search errors} { new mydoctools catch {mydoctools search} result mydoctools destroy set result } [tcltest::getErrorMessage "::doctools::_search" "name path" 1] test doctools-7.1 {search errors} { new mydoctools catch {mydoctools search foo bar} result mydoctools destroy set result } [tcltest::tooManyMessage "::doctools::_search" "name path"] test doctools-7.2 {search errors} { new mydoctools catch {mydoctools search foo} result mydoctools destroy set result } {mydoctools search: path does not exist} test doctools-7.3 {search, initial} { new mydoctools set res [llength $::doctools::doctoolsmydoctools::paths] mydoctools destroy set res } 0 test doctools-7.4 {extend object search paths} { new mydoctools mydoctools search [file dirname [info script]] set res [list] lappend res [llength $::doctools::doctoolsmydoctools::paths] lappend res [lindex $::doctools::doctoolsmydoctools::paths 0] mydoctools destroy set res } [list 1 [file dirname [info script]]] # format & warnings ....................................................... test doctools-8.0 {format errors} { new mydoctools catch {mydoctools format} result mydoctools destroy set result } [tcltest::getErrorMessage "::doctools::_format" "name text" 1] test doctools-8.1 {format errors} { new mydoctools catch {mydoctools format foo bar} result mydoctools destroy set result } [tcltest::tooManyMessage "::doctools::_format" "name text"] test doctools-8.2 {format errors} { new mydoctools catch {mydoctools format foo} result mydoctools destroy set result } {mydoctools: No format was specified} test doctools-8.3 {format} { new mydoctools -format list set res [mydoctools format {[manpage_begin foo n 1.0][description][strong foo][manpage_end]}] lappend res [mydoctools warnings] mydoctools destroy set res } {manpage {seealso {} keywords {} file {} section n module {} version 1.0 title foo shortdesc {} desc {} fid {}} {}} test doctools-8.4 {format} { new mydoctools -format list -deprecated on set res [mydoctools format {[manpage_begin foo n 1.0][description][strong foo][manpage_end]}] lappend res [mydoctools warnings] mydoctools destroy set res } {manpage {seealso {} keywords {} file {} section n module {} version 1.0 title foo shortdesc {} desc {} fid {}} {{Manpage warning (depr_strong): Deprecated command "[strong {foo}]". Manpage warning (depr_strong): Please consider appropriate semantic markup or [emph] instead.}}} # doctools manpage syntax ....................................................... test doctools-9.0 {manpage syntax} { new mydoctools -format null catch {mydoctools format foo} result mydoctools destroy set result } {Manpage error (body), "plain_text foo" : Plain text not allowed outside of the body of the manpage.} namespace forget ::doctools::new ::tcltest::cleanupTests