Index: modules/struct/ChangeLog ================================================================== --- modules/struct/ChangeLog +++ modules/struct/ChangeLog @@ -1,5 +1,12 @@ +2013-03-18 Andreas Kupries + + * queue.testsuite: [Bug 3608240]: Fixed get/peek not taking + * queue_oo.tcl: the amount of already delivered elements + * queue_tcl.tcl: into account. Extended testsuite. Bumped version + to 1.4.5 + 2013-02-01 Andreas Kupries * * Released and tagged Tcllib 1.15 ======================== * Index: modules/struct/queue.tcl ================================================================== --- modules/struct/queue.tcl +++ modules/struct/queue.tcl @@ -182,6 +182,6 @@ namespace eval ::struct { # Export the constructor command. namespace export queue } -package provide struct::queue 1.4.4 +package provide struct::queue 1.4.5 Index: modules/struct/queue.testsuite ================================================================== --- modules/struct/queue.testsuite +++ modules/struct/queue.testsuite @@ -336,7 +336,37 @@ myqueue unget foo set res [myqueue peek [myqueue size]] myqueue destroy set res } {foo d e f} + +#---------------------------------------------------------------------- + +test queue-${impl}-sf-3608240-a {} { + struct::queue qp + qp put 1 2 3 + set r {} + lappend r [qp peek [qp size]] + lappend r [qp get] + lappend r [qp peek [qp size]] + qp put 4 5 + lappend r [qp peek [qp size]] + qp destroy + set r +} {{1 2 3} 1 {2 3} {2 3 4 5}} +catch { unset r } + +test queue-${impl}-sf-3608240-b {} { + struct::queue qp + qp put 1 2 3 + set r {} + lappend r [qp peek [qp size]] + lappend r [qp get] + lappend r [qp peek [qp size]] + qp put 4 5 + lappend r [qp get [qp size]] + qp destroy + set r +} {{1 2 3} 1 {2 3} {2 3 4 5}} +catch { unset r } #---------------------------------------------------------------------- Index: modules/struct/queue_oo.tcl ================================================================== --- modules/struct/queue_oo.tcl +++ modules/struct/queue_oo.tcl @@ -76,13 +76,13 @@ } # Otherwise, return a list of items if {$count > ([llength $qret] - $qat)} { - # Need all of qret and parts of qadd, maybe all. + # Need all of qret (from qat on) and parts of qadd, maybe all. set max [expr {$qat + $count - 1 - [llength $qret]}] - set result [concat $qret [lrange $qadd 0 $max]] + set result [concat [lrange $qret $qat end] [lrange $qadd 0 $max]] my Shift set qat $max } else { # Request can be satisified from qret alone. set max [expr {$qat + $count - 1}] @@ -123,13 +123,13 @@ } # Otherwise, return a list of items if {$count > [llength $qret] - $qat} { - # Need all of qret and parts of qadd, maybe all. + # Need all of qret (from qat on) and parts of qadd, maybe all. set over [expr {$qat + $count - 1 - [llength $qret]}] - return [concat $qret [lrange $qadd 0 $over]] + return [concat [lrange $qret $qat end] [lrange $qadd 0 $over]] } else { # Request can be satisified from qret alone. return [lrange $qret $qat [expr {$qat + $count - 1}]] } } Index: modules/struct/queue_tcl.tcl ================================================================== --- modules/struct/queue_tcl.tcl +++ modules/struct/queue_tcl.tcl @@ -219,13 +219,13 @@ } # Otherwise, return a list of items if {$count > ([llength $RET] - $AT)} { - # Need all of RET and parts of ADD, maybe all. + # Need all of RET (from AT on) and parts of ADD, maybe all. set max [expr {$count - ([llength $RET] - $AT) - 1}] - set result [concat $RET [lrange $ADD 0 $max]] + set result [concat [lrange $RET $AT end] [lrange $ADD 0 $max]] Shift $name set AT $max } else { # Request can be satisified from RET alone. set max [expr {$AT + $count - 1}] @@ -271,13 +271,13 @@ } # Otherwise, return a list of items if {$count > [llength $RET] - $AT} { - # Need all of RET and parts of ADD, maybe all. + # Need all of RET (from AT on) and parts of ADD, maybe all. set over [expr {$count - ([llength $RET] - $AT) - 1}] - return [concat $RET [lrange $ADD 0 $over]] + return [concat [lrange $RET $AT end] [lrange $ADD 0 $over]] } else { # Request can be satisified from RET alone. return [lrange $RET $AT [expr {$AT + $count - 1}]] } }