# -*- tcl -*-
# stack.test:  tests for the stack 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) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
# RCS: @(#) $Id: stack.testsuite,v 1.2 2009/11/26 04:42:16 andreas_kupries Exp $

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

::tcltest::testConstraint stack_critcl [string equal $impl critcl]

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

test stack-${impl}-0.1 {stack errors} {
    stack mystack
    catch {stack mystack} msg
    mystack destroy
    set msg
} "command \"::mystack\" already exists, unable to create stack"
test stack-${impl}-0.2 {stack errors} {badTest} {
    stack mystack
    catch {mystack} msg
    mystack destroy
    set msg
} "wrong # args: should be \"::mystack option ?arg arg ...?\""
test stack-${impl}-0.3 {stack errors} {
    stack mystack
    catch {mystack foo} msg
    mystack destroy
    set msg
} "bad option \"foo\": must be clear, destroy, get, peek, pop, push, rotate, size, or trim"
test stack-${impl}-0.4 {stack errors} {
    catch {stack set} msg
    set msg
} "command \"::set\" already exists, unable to create stack"

test stack-${impl}-1.1 {stack creation} {
    set foo [stack mystack]
    set cmd [info commands ::mystack]
    set size [mystack size]
    mystack destroy
    list $foo $cmd $size
} {::mystack ::mystack 0}
test stack-${impl}-1.2 {stack creation} {
    set foo [stack]
    set cmd [info commands ::$foo]
    set size [$foo size]
    $foo destroy
    list $foo $cmd $size
} {::stack1 ::stack1 0}

test stack-${impl}-2.1 {stack destroy} {
    stack mystack
    mystack destroy
    info commands ::mystack
} {}

test stack-${impl}-3.2 {size operation} {
    stack mystack
    mystack push a b c d e f g
    set size [mystack size]
    mystack destroy
    set size
} 7
test stack-${impl}-3.3 {size operation} {
    stack mystack
    mystack push a b c d e f g
    mystack pop 3
    set size [mystack size]
    mystack destroy
    set size
} 4
test stack-${impl}-3.4 {size operation} {
    stack mystack
    mystack push a b c d e f g
    mystack pop 3
    mystack peek 3
    set size [mystack size]
    mystack destroy
    set size
} 4
    
test stack-${impl}-4.1 {push operation} {
    stack mystack
    catch {mystack push} msg
    mystack destroy
    set msg
} "wrong # args: should be \"$MY push item ?item ...?\""
test stack-${impl}-4.2 {push operation, singleton items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} "c b a"
test stack-${impl}-4.3 {push operation, multiple items} {
    stack mystack
    mystack push a b c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} "c b a"
test stack-${impl}-4.4 {push operation, spaces in items} {
    stack mystack
    mystack push a b "foo bar"
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list "foo bar" b a]
test stack-${impl}-4.5 {push operation, bad chars in items} {
    stack mystack
    mystack push a b \{
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list \{ b a]

test stack-${impl}-5.1 {pop operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack pop] [mystack pop] [mystack pop]]
    mystack destroy
    set result
} [list c b a]
test stack-${impl}-5.2 {pop operation, multiple items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [mystack pop 3]
    mystack destroy
    set result
} [list c b a]

test stack-${impl}-6.1 {peek operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek] [mystack peek] [mystack peek]]
    mystack destroy
    set result
} [list c c c]

test stack-${impl}-6.2 {peek operation} {
    stack mystack
    catch {mystack peek 0} msg
    mystack destroy
    set msg
} {invalid item count 0}
test stack-${impl}-6.3 {peek operation} {
    stack mystack
    catch {mystack peek -1} msg
    mystack destroy
    set msg
} {invalid item count -1}
test stack-${impl}-6.4 {peek operation} {
    stack mystack
    catch {mystack peek} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}
test stack-${impl}-6.5 {peek operation} {
    stack mystack
    mystack push a
    catch {mystack peek 2} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}

test stack-${impl}-6.6 {pop operation, multiple items} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek 3] [mystack pop 3]]
    mystack destroy
    set result
} [list [list c b a] [list c b a]]

test stack-${impl}-6.7 {pop operation} {
    stack mystack
    catch {mystack pop 0} msg
    mystack destroy
    set msg
} {invalid item count 0}
test stack-${impl}-6.8 {pop operation} {
    stack mystack
    catch {mystack pop -1} msg
    mystack destroy
    set msg
} {invalid item count -1}
test stack-${impl}-6.9 {pop operation} {
    stack mystack
    catch {mystack pop} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}
test stack-${impl}-6.10 {pop operation} {
    stack mystack
    mystack push a
    catch {mystack pop 2} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}

test stack-${impl}-7.1 {clear operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    set result [list [mystack peek 3]]
    mystack clear
    lappend result [mystack size]
    mystack destroy
    set result
} [list [list c b a] 0]

test stack-${impl}-8.1 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 1
    set result [mystack get]
    mystack destroy
    set result
} [list g f h e d c b a]
test stack-${impl}-8.2 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 2
    set result [mystack get]
    mystack destroy
    set result
} [list f h g e d c b a]
test stack-${impl}-8.3 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 3 5
    set result [mystack get]
    mystack destroy
    set result
} [list f h g e d c b a]
test stack-${impl}-8.4 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 8 1
    set result [mystack get]
    mystack destroy
    set result
} [list g f e d c b a h]
test stack-${impl}-8.5 {rotate operation} {
    stack mystack
    mystack push a b c d e f g h
    mystack rotate 8 -1
    set result [mystack get]
    mystack destroy
    set result
} [list a h g f e d c b]
test stack-${impl}-8.6 {rotate operation} {
    stack mystack
    catch {mystack rotate 8 -1} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}
test stack-${impl}-8.7 {rotate operation} {
    stack mystack
    mystack push a b c d
    catch {mystack rotate 8 -1} msg
    mystack destroy
    set msg
} {insufficient items on stack to fill request}

test stack-${impl}-9.0 {get operation, wrong args, too many} {
    stack mystack
    catch {mystack get X} msg
    mystack destroy
    set msg
} [tmTooMany get {}]

test stack-${impl}-9.1 {get operation, empty stack} {
    stack mystack
    set result [mystack get]
    mystack destroy
    set result
} {}

test stack-${impl}-9.2 {get operation} {
    stack mystack
    mystack push a b c d
    set result [mystack get]
    mystack destroy
    set result
} {d c b a}

test stack-${impl}-9.3 {get operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    mystack push d
    set result [mystack get]
    mystack destroy
    set result
} {d c b a}

test stack-${impl}-10.0 {trim operation, wrong args, not enough} {
    stack mystack
    catch {mystack trim} msg
    mystack destroy
    set msg
} [tmWrong trim {newsize} 0]

test stack-${impl}-10.1 {trim operation, wrong args, too many} {
    stack mystack
    catch {mystack trim X Y} msg
    mystack destroy
    set msg
} [tmTooMany trim {newsize}]

test stack-${impl}-10.2 {trim operation, bad argument} {
    stack mystack
    catch {mystack trim X} msg
    mystack destroy
    set msg
} {expected integer but got "X"}

test stack-${impl}-10.3 {trim operation, bad argument} {
    stack mystack
    catch {mystack trim -4} msg
    mystack destroy
    set msg
} {invalid size -4}

test stack-${impl}-10.4 {trim operation, empty stack} {
    stack mystack
    set     result [mystack size]
    lappend result [mystack trim 1]
    lappend result [mystack size]
    mystack destroy
    set result
} {0 {} 0}

test stack-${impl}-10.5 {trim operation} {
    stack mystack
    mystack push a b c d
    set     result [mystack size]
    lappend result [mystack trim 1]
    lappend result [mystack size]
    mystack destroy
    set result
} {4 {d c b} 1}

test stack-${impl}-10.6 {trim operation} {
    stack mystack
    mystack push a
    mystack push b
    mystack push c
    mystack push d
    set     result [mystack size]
    lappend result [mystack trim 1]
    lappend result [mystack size]
    mystack destroy
    set result
} {4 {d c b} 1}

test stack-${impl}-10.7 {trim operation} {
    stack mystack
    mystack push a b c d
    set     result [mystack size]
    lappend result [mystack trim 5]
    lappend result [mystack size]
    mystack destroy
    set result
} {4 {} 4}