# -*- tcl -*-
# docidx.test:  tests for the doctools::idx 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: docidx.test,v 1.1 2003/03/05 06:50:33 andreas_kupries Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require doctools::idx
puts "doctools::idx [package present doctools::idx]"

namespace import ::doctools::idx::new

# search paths .............................................................

test docidx-1.0 {default search paths} {
    llength $::doctools::idx::paths
} 1

test docidx-1.1 {extend package search paths} {
    ::doctools::idx::search [file dirname [info script]]
    set     res [list]
    lappend res [llength $::doctools::idx::paths]
    lappend res [lindex  $::doctools::idx::paths 0]
    set     res
} [list 2 [file dirname [info script]]]

test docidx-1.2 {extend package search paths, error} {
    catch {::doctools::idx::search foo} result
    set     result
} {doctools::idx::search: path does not exist}

# format help .............................................................

test docidx-2.0 {format help} {
    string length [doctools::idx::help]
} 368

# docidx .............................................................

test docidx-3.0 {docidx errors} {
    catch {new} msg
    set msg
} [tcltest::getErrorMessage "new" "name args" 0]

test docidx-3.1 {docidx errors} {
    catch {new set} msg
    set msg
} "command \"set\" already exists, unable to create docidx object"

test docidx-3.2 {docidx errors} {
    new mydocidx
    catch {new mydocidx} msg
    mydocidx destroy
    set msg
} "command \"mydocidx\" already exists, unable to create docidx object"

test docidx-3.3 {docidx errors} {
    catch {new mydocidx -foo} msg
    set msg
} {wrong # args: doctools::new name ?opt val...??}

# docidx methods ......................................................

test docidx-4.0 {docidx method errors} {
    new mydocidx
    catch {mydocidx} msg
    mydocidx destroy
    set msg
} "wrong # args: should be \"mydocidx option ?arg arg ...?\""

test docidx-4.1 {docidx errors} {
    new mydocidx
    catch {mydocidx foo} msg
    mydocidx destroy
    set msg
} "bad option \"foo\": must be cget, configure, destroy, format, map, search, warnings, parameters, or setparam"

# cget ..................................................................

test docidx-5.0 {cget errors} {
    new mydocidx
    catch {mydocidx cget} result
    mydocidx destroy
    set result
} [tcltest::getErrorMessage "::doctools::idx::_cget" "name option" 1]

test docidx-5.1 {cget errors} {
    new mydocidx
    catch {mydocidx cget foo bar} result
    mydocidx destroy
    set result
} [tcltest::tooManyMessage "::doctools::idx::_cget" "name option"]

test docidx-5.2 {cget errors} {
    new mydocidx
    catch {mydocidx cget -foo} result
    mydocidx destroy
    set result
} {doctools::idx::_configure: Unknown option "-foo", expected -file, or -format}

foreach {na nb option default newvalue} {
    3  4 -file       {} foo
    5  6 -format     {} html
} {
    test docidx-5.$na {cget query} {
	new mydocidx
	set res [mydocidx cget $option]
	mydocidx destroy
	set res
    } $default ; # {}

    test docidx-5.$nb {cget set & query} {
	new mydocidx
	mydocidx configure $option $newvalue
	set res [mydocidx cget $option]
	mydocidx destroy
	set res
    } $newvalue ; # {}
}

# configure ..................................................................

test docidx-6.0 {configure errors} {
    new mydocidx
    catch {mydocidx configure -foo bar -glub} result
    mydocidx destroy
    set result
} {wrong # args: doctools::idx::_configure name ?opt val...??}
# [tcltest::getErrorMessage "::doctools::idx::_configure" "name ?option?|?option value...?" 1]

test docidx-6.1 {configure errors} {
    new mydocidx
    catch {mydocidx configure -foo} result
    mydocidx destroy
    set result
} {doctools::idx::_configure: Unknown option "-foo", expected -file, or -format}

test docidx-6.2 {configure retrieval} {
    new mydocidx
    catch {mydocidx configure} result
    mydocidx destroy
    set result
} {-file {} -format {}}

foreach {n option illegalvalue result} {
    3 -format     barf {doctools::idx::_configure: -format: Unknown format "barf"}
} {
    test docidx-6.$n {configure illegal value} {
	new mydocidx
	catch {mydocidx configure $option $illegalvalue} result
	mydocidx destroy
	set result
    } $result
}

foreach {na nb option default newvalue} {
    4  5 -file       {} foo
    6  7 -format     {} html
} {
    test docidx-6.$na {configure query} {
	new mydocidx
	set res [mydocidx configure $option]
	mydocidx destroy
	set res
    } $default ; # {}

    test docidx-6.$nb {configure set & query} {
	new mydocidx
	mydocidx configure $option $newvalue
	set res [mydocidx configure $option]
	mydocidx destroy
	set res
    } $newvalue ; # {}
}

test docidx-6.8 {configure full retrieval} {
    new mydocidx -file foo -format html
    catch {mydocidx configure} result
    mydocidx destroy
    set result
} {-file foo -format html}

# search ..................................................................

test docidx-7.0 {search errors} {
    new mydocidx
    catch {mydocidx search} result
    mydocidx destroy
    set result
} [tcltest::getErrorMessage "::doctools::idx::_search" "name path" 1]

test docidx-7.1 {search errors} {
    new mydocidx
    catch {mydocidx search foo bar} result
    mydocidx destroy
    set result
} [tcltest::tooManyMessage "::doctools::idx::_search" "name path"]

test docidx-7.2 {search errors} {
    new mydocidx
    catch {mydocidx search foo} result
    mydocidx destroy
    set result
} {mydocidx search: path does not exist}

test docidx-7.3 {search, initial} {
    new mydocidx
    set res [llength $::doctools::idx::docidxmydocidx::paths]
    mydocidx destroy
    set res
} 0

test docidx-7.4 {extend object search paths} {
    new mydocidx
    mydocidx search [file dirname [info script]]
    set     res [list]
    lappend res [llength $::doctools::idx::docidxmydocidx::paths]
    lappend res [lindex  $::doctools::idx::docidxmydocidx::paths 0]
    mydocidx destroy
    set     res
} [list 1 [file dirname [info script]]]

# format & warnings .......................................................

test docidx-8.0 {format errors} {
    new mydocidx
    catch {mydocidx format} result
    mydocidx destroy
    set result
} [tcltest::getErrorMessage "::doctools::idx::_format" "name text" 1]

test docidx-8.1 {format errors} {
    new mydocidx
    catch {mydocidx format foo bar} result
    mydocidx destroy
    set result
} [tcltest::tooManyMessage "::doctools::idx::_format" "name text"]

test docidx-8.2 {format errors} {
    new mydocidx
    catch {mydocidx format foo} result
    mydocidx destroy
    set result
} {mydocidx: No format was specified}


test docidx-8.3 {format} {
    new mydocidx -format wiki
    set res [mydocidx format {[index_begin foo bar][key snafu][manpage at fubar][index_end]}]
    lappend res [mydocidx warnings]
    mydocidx destroy
    set res
} {Index '''foo''' '''bar''' '''snafu''': at {}}


# docidx manpage syntax .......................................................

test docidx-9.0 {docidx syntax} {
    new mydocidx -format null
    catch {mydocidx format foo} result
    mydocidx destroy
    set result
} {IDX error (idx/plaintext), "plain_text foo" : Plain text beyond whitespace is not allowed..}


namespace forget ::doctools::idx::new
::tcltest::cleanupTests