# -*- 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 <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: doctools.test,v 1.5 2004/02/14 05:59:20 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

# ---------------------------------------------------

# Takes a dictionary, returns a list containing the same dictionary,
# however the keys are sorted alphabetically. This allows for a true
# comparison of dictionary results.

proc dictsort {dict} {
    array set a $dict
    set out [list]
    foreach key [lsort [array names a]] {
	lappend out $key $a($key)
    }
    return $out
}

# ---------------------------------------------------

# 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::wrongNumArgs "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::wrongNumArgs "::doctools::_cget" "name option" 1]

test doctools-5.1 {cget errors} {
    new mydoctools
    catch {mydoctools cget foo bar} result
    mydoctools destroy
    set result
} [tcltest::tooManyArgs "::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::wrongNumArgs "::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::wrongNumArgs "::doctools::_search" "name path" 1]

test doctools-7.1 {search errors} {
    new mydoctools
    catch {mydoctools search foo bar} result
    mydoctools destroy
    set result
} [tcltest::tooManyArgs "::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::wrongNumArgs "::doctools::_format" "name text" 1]

test doctools-8.1 {format errors} {
    new mydoctools
    catch {mydoctools format foo bar} result
    mydoctools destroy
    set result
} [tcltest::tooManyArgs "::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]}]
    set res [list [lindex $res 0] [dictsort [lindex $res 1]]]
    lappend res [mydoctools warnings]
    mydoctools destroy
    set res
} {manpage {desc {} fid {} file {} keywords {} module {} section n seealso {} shortdesc {} title foo version 1.0} {}}

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]}]
    set res [list [lindex $res 0] [dictsort [lindex $res 1]]]
    lappend res [mydoctools warnings]
    mydoctools destroy
    set res
} {manpage {desc {} fid {} file {} keywords {} module {} section n seealso {} shortdesc {} title foo version 1.0} {{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
