π Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io π

# glennj's solution

## to Circular Buffer in the Tcl Track

Published at Apr 01 2020 · 0 comments
Instructions
Test suite
Solution

#### Note:

This exercise has changed since this solution was written.

A circular buffer, cyclic buffer or ring buffer is a data structure that uses a single, fixed-size buffer as if it were connected end-to-end.

A circular buffer first starts empty and of some predefined length. For example, this is a 7-element buffer:

``````[ ][ ][ ][ ][ ][ ][ ]
``````

Assume that a 1 is written into the middle of the buffer (exact starting location does not matter in a circular buffer):

``````[ ][ ][ ][1][ ][ ][ ]
``````

Then assume that two more elements are added β 2 & 3 β which get appended after the 1:

``````[ ][ ][ ][1][2][3][ ]
``````

If two elements are then removed from the buffer, the oldest values inside the buffer are removed. The two elements removed, in this case, are 1 & 2, leaving the buffer with just a 3:

``````[ ][ ][ ][ ][ ][3][ ]
``````

If the buffer has 7 elements then it is completely full:

``````[6][7][8][9][3][4][5]
``````

When the buffer is full an error will be raised, alerting the client that further writes are blocked until a slot becomes free.

When the buffer is full, the client can opt to overwrite the oldest data with a forced write. In this case, two more elements β A & B β are added and they overwrite the 3 & 4:

``````[6][7][8][9][A][B][5]
``````

3 & 4 have been replaced by A & B making 5 now the oldest data in the buffer. Finally, if two elements are removed then what would be returned is 5 & 6 yielding the buffer:

``````[ ][7][8][9][A][B][ ]
``````

Because there is space available, if the client again uses overwrite to store C & D then the space where 5 & 6 were stored previously will be used not the location of 7 & 8. 7 is still the oldest element and the buffer is once again full.

``````[D][7][8][9][A][B][C]
``````

## Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

## Running the tests

To run the test suite, execute one of the following commands:

``````tclsh circular-buffer.test            # Will stop testing after the first failure.
RUN_ALL=1 tclsh circular-buffer.test  # Will run all tests and report all failures.
``````

## Feedback, Issues, Pull Requests

The exercism/tcl repository on GitHub is the home for all of the Tcl exercises on Exercism.

If you have feedback about an exercise, or want to help implementing a new one, head over there and create an issue. We'll do our best to help you!

## Source

### circular-buffer.test

``````#!/usr/bin/env tclsh
set version 1.2.0
package require tcltest
namespace import ::tcltest::*
source "circular-buffer.tcl"

proc fail_fast {} {
return [expr {
![info exists ::env(RUN_ALL)]
|| [string is boolean -strict \$::env(RUN_ALL)]
&& !\$::env(RUN_ALL)
}]
}

proc failed {} {
return [expr {\$::tcltest::numTests(Failed) > 0}]
}

if {[fail_fast]} {
proc test args {
if {[failed]} {::tcltest::configure -skip *}
uplevel [list ::tcltest::test {*}\$args]
}
}

proc cleanupTests {} {
set failed [failed]
uplevel 1 ::tcltest::cleanupTests
if {\$failed} {exit 1}
}

customMatch boolean booleanMatch
proc booleanMatch {expected actual} {
return [expr {
[string is boolean -strict \$expected] &&
[string is boolean -strict \$actual] &&
((\$expected && \$actual) || (!\$expected && !\$actual))
}]
}

if {\$::argv0 eq [info script]} {

test circular-buffer-0.1 "new buffer is empty" -body {
set b [CircularBuffer new 2]
\$b empty?
} -returnCodes ok -match boolean -result true

test circular-buffer-0.2 "non-empty buffer is not empty" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b empty?
} -returnCodes ok -match boolean -result false

test circular-buffer-0.3 "full buffer is full" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b write 2
\$b full?
} -returnCodes ok -match boolean -result true

test circular-buffer-0.4 "non-full buffer is not full" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b full?
} -returnCodes ok -match boolean -result false

test circular-buffer-1 "reading empty buffer should fail" -body {
set b [CircularBuffer new 1]
} -returnCodes error -result "buffer is empty"

test circular-buffer-2 "can read an item just written" -body {
set b [CircularBuffer new 1]
\$b write 1
} -returnCodes ok -result "1"

test circular-buffer-3 "each item may only be read once" -body {
set b [CircularBuffer new 1]
\$b write 1
} -returnCodes error -result "buffer is empty"

test circular-buffer-4 "items are read in the order they are written" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b write 2
set values {}
lappend values [\$b read]
lappend values [\$b read]
} -returnCodes ok -result {1 2}

test circular-buffer-5 "full buffer can't be written to" -body {
set b [CircularBuffer new 1]
\$b write 1
\$b write 2
} -returnCodes error -result "buffer is full"

test circular-buffer-6 "a read frees up capacity for another write" -body {
set b [CircularBuffer new 1]
\$b write 1
\$b write 2
} -returnCodes ok -result "2"

test circular-buffer-7 "read position is maintained even across multiple writes" -body {
set b [CircularBuffer new 3]
\$b write 1
\$b write 2
\$b write 3
} -returnCodes ok -result "3"

test circular-buffer-8 "items cleared out of buffer can't be read" -body {
set b [CircularBuffer new 1]
\$b write 1
\$b clear
} -returnCodes error -result "buffer is empty"

test circular-buffer-9 "clear frees up capacity for another write" -body {
set b [CircularBuffer new 1]
\$b write 1
\$b clear
\$b write 2
} -returnCodes ok -result "2"

test circular-buffer-10 "clear does nothing on an empty buffer" -body {
set b [CircularBuffer new 1]
\$b clear
} -returnCodes ok -result ""

test circular-buffer-11 "overwrite acts like write on non-full buffer" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b overwrite 2
set values {}
lappend values [\$b read]
lappend values [\$b read]
} -returnCodes ok -result {1 2}

test circular-buffer-12 "overwrite replaces the oldest item on full buffer" -body {
set b [CircularBuffer new 2]
\$b write 1
\$b write 2
\$b overwrite 3
set values {}
lappend values [\$b read]
lappend values [\$b read]
} -returnCodes ok -result {2 3}

test circular-buffer-13 "overwrite replaces the oldest item remaining in buffer following a read" -body {
set b [CircularBuffer new 3]
\$b write 1
\$b write 2
\$b write 3
\$b write 4
\$b overwrite 5
set values {}
lappend values [\$b read]
lappend values [\$b read]
lappend values [\$b read]
} -returnCodes ok -result {3 4 5}

test circular-buffer-14 "initial clear does not affect wrapping around" -body {
set b [CircularBuffer new 2]
\$b clear
\$b write 1
\$b write 2
\$b overwrite 3
\$b overwrite 4
# some inelegant code: collect the results to ensure
# the 3rd read is the one with the error.
set result {}
lappend result [\$b read]
lappend result [\$b read]
try {
} on error {} {
lappend result "err"
}
} -returnCodes ok -result {3 4 err}

cleanupTests
}``````
``````oo::class create CircularBuffer {
variable tape
variable NULL

constructor {cap} {
set NULL \x0
set tape [lrepeat \$cap \$NULL]
my clear
}

method empty? {} {
expr {[lindex \$tape \$readPtr] eq \$NULL}
}

method full? {} {
expr {[lindex \$tape \$writePtr] ne \$NULL}
}

method read {} {
if {[my empty?]} {
error "buffer is empty"
}
set value [lindex \$tape \$readPtr]
lset tape \$readPtr \$NULL
return \$value
}

method write {value} {
if {[my full?]} {
error "buffer is full"
}
lset tape \$writePtr \$value
my increment writePtr
return
}

method increment {ptrName} {
upvar 1 \$ptrName ptr
# implement the circularity: wrap to zero when at end of tape
set ptr [expr {(1 + \$ptr) % [llength \$tape]}]
}
unexport increment ;# private

method overwrite {value} {
if {[my full?]} {
# discard oldest value
}
my write \$value
}

method clear {} {
set tape [lmap cell \$tape {set NULL}]
set writePtr 0
return
}
}``````