Tcl Library Source Code

2013-03-18  Andreas Kupries  <[email protected]>

	* 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  <[email protected]>

	*
	* Released and tagged Tcllib 1.15 ========================
	* 

2013-01-21  Andreas Kupries  <[email protected]>

## Ready

namespace eval ::struct {
    # Export the constructor command.
    namespace export queue
}

package provide struct::queue 1.4.5

    myqueue put a b c d e f
    myqueue get 3
    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 }

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

	    my Shift?
	    return $item
	}

	# Otherwise, return a list of items

	if {$count > ([llength $qret] - $qat)} {
	    # Need all of qret (from qat on) and parts of qadd, maybe all.
	    set max    [expr {$qat + $count - 1 - [llength $qret]}]
	    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}]
	    set result [lrange $qret $qat $max]
	    set qat $max

	    # listified
	    return [lindex $qret $qat]
	}

	# Otherwise, return a list of items

	if {$count > [llength $qret] - $qat} {
	    # Need all of qret (from qat on) and parts of qadd, maybe all.
	    set over [expr {$qat + $count - 1 - [llength $qret]}]
	    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}]]
	}
    }

    # put --

	Shift? $name
	return $item
    }

    # Otherwise, return a list of items

    if {$count > ([llength $RET] - $AT)} {
	# Need all of RET (from AT on) and parts of ADD, maybe all.
	set max    [expr {$count - ([llength $RET] - $AT) - 1}]
	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}]
	set result [lrange $RET $AT $max]
	set AT $max

	# listified
	return [lindex $RET $AT]
    }

    # Otherwise, return a list of items

    if {$count > [llength $RET] - $AT} {
	# Need all of RET (from AT on) and parts of ADD, maybe all.
	set over [expr {$count - ([llength $RET] - $AT) - 1}]
	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}]]
    }
}

# ::struct::queue::I::put --