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

TSeydel's solution

to Circular Buffer in the Delphi Pascal Track

Published at Aug 11 2020 · 0 comments
Instructions
Test suite
Solution

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]

Testing

In order to run the tests for this track, you will need to install DUnitX. Please see the installation instructions for more information.

Loading Exercises into Delphi

If Delphi is properly installed, and *.dpr file types have been associated with Delphi, then double clicking the supplied *.dpr file will start Delphi and load the exercise/project. control + F9 is the keyboard shortcut to compile the project or pressing F9 will compile and run the project.

Alternatively you may opt to start Delphi and load your project via. the File drop down menu.

When Questions Come Up

We monitor the Pascal-Delphi support room on gitter.im to help you with any questions that might arise.

Submitting Exercises

Note that, when trying to submit an exercise, make sure the exercise file you're submitting is in the exercism/delphi/<exerciseName> directory.

For example, if you're submitting ubob.pas for the Bob exercise, the submit command would be something like exercism submit <path_to_exercism_dir>/delphi/bob/ubob.pas.

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you may request help from a mentor.

uCircularBufferTests.pas

unit uCircularBufferTests;

interface
uses
DUnitX.TestFramework;

const
CanonicalVersion = '1.0.1';

type

[TestFixture]
TestCircularBuffer = class(TObject)
public
[Test]
//  [Ignore('Comment the "[Ignore]" statement to run the test')]
procedure reading_empty_buffer_should_fail;

[Test]
[Ignore]
procedure can_read_an_item_just_written;

[Test]
[Ignore]
procedure Write_and_read_back_multiple_items;

[Test]
[Ignore]
procedure each_item_may_only_be_read_once;

[Test]
[Ignore]
procedure items_are_read_in_the_order_they_are_written;

[Test]
[Ignore]
procedure full_buffer_cannot_be_written_to;

[Test]
[Ignore]
procedure a_read_frees_up_capacity_for_another_write;

[Test]
[Ignore]
procedure read_position_is_maintained_even_across_multiple_writes;

[Test]
[Ignore]
procedure items_cleared_out_of_buffer_cannot_be_read;

[Test]
[Ignore]
procedure clear_frees_up_capacity_for_another_write;

[Test]
[Ignore]
procedure clear_does_nothing_on_empty_buffer;

[Test]
[Ignore]
procedure overwrite_acts_like_write_on_non_full_buffer;

[Test]
[Ignore]
procedure overwrite_replaces_the_oldest_item_on_full_buffer;

[Test]
[Ignore]
procedure overwrite_replaces_the_oldest_item_remaining_in_buffer_following_a_read;
end;

implementation
uses System.SysUtils, uCircularBuffer;

procedure TestCircularBuffer.can_read_an_item_just_written;
var MyBuffer: ICircularBuffer<char>;
Actual: char;
begin
MyBuffer := TCircularBuffer<char>.Create(1);
MyBuffer.Write('1');
Actual := MyBuffer.Read;
assert.AreEqual('1', Actual);
end;

procedure TestCircularBuffer.clear_does_nothing_on_empty_buffer;
var MyBuffer: ICircularBuffer<integer>;
Actual: integer;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.Create(1);
MyBuffer.Clear;

MyProc := procedure
begin
MyBuffer.Write(1);
end;

Assert.WillNotRaise(MyProc, EInvalidOpException);

Actual := MyBuffer.Read;
Assert.AreEqual(1, Actual);
end;

procedure TestCircularBuffer.clear_frees_up_capacity_for_another_write;
var MyBuffer: ICircularBuffer<integer>;
Actual: integer;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.Create(1);
MyBuffer.Write(1);
MyBuffer.Clear;

MyProc := procedure
begin
MyBuffer.Write(2);
end;

Assert.WillNotRaise(MyProc, EInvalidOpException);

Actual := MyBuffer.Read;
Assert.AreEqual(2, Actual);
end;

procedure TestCircularBuffer.Write_and_read_back_multiple_items;
var MyBuffer: ICircularBuffer<char>;
Act1, Act2: char;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<char>.Create(2);
MyBuffer.Write('1');
MyBuffer.Write('2');

Act1 := MyBuffer.Read;
Act2 := MyBuffer.Read;

Assert.AreEqual('1', Act1);
Assert.AreEqual('2', Act2);

MyProc := procedure
begin
MyBuffer.Read;
end;

Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.items_cleared_out_of_buffer_cannot_be_read;
var MyBuffer: ICircularBuffer<char>;
Act1, Act2: char;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<char>.Create(1);

MyBuffer.Write('1');

MyBuffer.Clear;

MyProc := procedure
begin
MyBuffer.Read;
end;
Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.each_item_may_only_be_read_once;
var MyBuffer: ICircularBuffer<integer>;
Actual: integer;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.Create(1);
MyBuffer.Write(1);
Actual := MyBuffer.Read;
assert.AreEqual(1, Actual);
MyProc := procedure
begin
MyBuffer.Read;
end;
Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.a_read_frees_up_capacity_for_another_write;
var MyBuffer: ICircularBuffer<integer>;
Actual: integer;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.create(1);
MyBuffer.Write(1);
Actual := MyBuffer.Read;

MyProc := procedure
begin
MyBuffer.Write(2);
end;
Assert.WillNotRaise(MyProc, EInvalidOpException);
Actual := MyBuffer.Read;
Assert.AreEqual(2, Actual);
end;

procedure TestCircularBuffer.read_position_is_maintained_even_across_multiple_writes;
var MyBuffer: ICircularBuffer<char>;
Actual: char;
begin
MyBuffer := TCircularBuffer<char>.create(3);
MyBuffer.Write('1');
MyBuffer.Write('2');
Actual := MyBuffer.Read;
Assert.AreEqual('1', Actual);

MyBuffer.Write('3');

Actual := MyBuffer.Read;
Assert.AreEqual('2',Actual);
Actual := MyBuffer.Read;
Assert.AreEqual('3',Actual);
end;

procedure TestCircularBuffer.full_buffer_cannot_be_written_to;
var MyBuffer: ICircularBuffer<char>;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<char>.create(1);
MyBuffer.Write('1');

MyProc := procedure
begin
MyBuffer.Write('2');
end;
Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.overwrite_replaces_the_oldest_item_on_full_buffer;
var MyBuffer: ICircularBuffer<integer>;
Act1, Act2: integer;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.create(2);
MyBuffer.Write(1);
MyBuffer.Write(2);
MyBuffer.OverWrite(3);

Act1 := MyBuffer.Read;
Act2 := MyBuffer.Read;

Assert.AreEqual(2, Act1);
Assert.AreEqual(3, Act2);
end;

procedure TestCircularBuffer.overwrite_replaces_the_oldest_item_remaining_in_buffer_following_a_read;
var MyBuffer: ICircularBuffer<integer>;
MyProc: TTestLocalMethod;
Actual: integer;
begin
MyBuffer := TCircularBuffer<integer>.create(3);
MyBuffer.Write(1);
MyBuffer.Write(2);
MyBuffer.Write(3);

Actual := MyBuffer.Read;
Assert.AreEqual(1,Actual);

MyBuffer.Write(4);
MyBuffer.OverWrite(5);

Actual := MyBuffer.Read;
Assert.AreEqual(3,Actual);
Actual := MyBuffer.Read;
Assert.AreEqual(4,Actual);
Actual := MyBuffer.Read;
Assert.AreEqual(5,Actual);
end;

procedure TestCircularBuffer.reading_empty_buffer_should_fail;
var MyBuffer: ICircularBuffer<integer>;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.create(2);
MyProc := procedure
begin
MyBuffer.Read;
end;
Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.overwrite_acts_like_write_on_non_full_buffer;
var MyBuffer: ICircularBuffer<char>;
Act1, Act2: char;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<char>.create(2);
MyBuffer.Write('1');
MyBuffer.OverWrite('2');

Act1 := MyBuffer.Read;
Act2 := MyBuffer.Read;

Assert.AreEqual('1', Act1);
Assert.AreEqual('2', Act2);
MyProc := procedure
begin
MyBuffer.Read;
end;
Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.items_are_read_in_the_order_they_are_written;
var MyBuffer: ICircularBuffer<char>;
Act: TArray<char>;
begin
SetLength(Act, 2);
MyBuffer := TCircularBuffer<char>.create(2);
MyBuffer.Write('1');
MyBuffer.Write('2');

Act[0] := MyBuffer.Read;
Act[1] := MyBuffer.Read;

Assert.AreEqual('1', Act[0]);
Assert.AreEqual('2', Act[1]);
end;

initialization
TDUnitX.RegisterTestFixture(TestCircularBuffer);
end.
unit uCircularBuffer;

interface

uses
System.Generics.Collections;

type
ICircularBuffer<T> = interface
['{8AA13482-B957-4188-B696-C40E2F48BC25}']
function Read: T;
procedure Write(aItem: T);
procedure OverWrite(aItem: T);
procedure Clear;
end;

TCircularBuffer<T> = class(TInterfacedObject,ICircularBuffer<T>)
private
FBuffer: TQueue<T>;
public
function Read: T;
procedure Write(aItem: T);
procedure OverWrite(aItem: T);
procedure Clear;
constructor Create(aSize: Integer);
end;

resourcestring
strEmptyBuffer = 'Buffer Empty; Unable to Read from Buffer.';
strFullBuffer = 'Buffer Full; Unable to Write to Buffer.';

implementation

uses
System.SysUtils;

procedure TCircularBuffer<T>.Clear;
begin
FBuffer.Clear;
end;

constructor TCircularBuffer<T>.Create(aSize: Integer);
begin
FBuffer := TQueue<T>.Create;
FBuffer.Capacity := aSize;
end;

procedure TCircularBuffer<T>.OverWrite(aItem: T);
begin
if FBuffer.Count = FBuffer.Capacity then
FBuffer.Dequeue;
FBuffer.Enqueue(aItem);
end;

function TCircularBuffer<T>.Read: T;
begin
if FBuffer.Count = 0 then
raise EInvalidOpException.Create(strEmptyBuffer);
Result := FBuffer.Dequeue;
end;

procedure TCircularBuffer<T>.Write(aItem: T);
begin
if FBuffer.Count = FBuffer.Capacity then
raise EInvalidOpException.Create(strEmptyBuffer);
FBuffer.Enqueue(aItem);
end;

end.

Community comments

Find this solution interesting? Ask the author a question to learn more.

What can you learn from this solution?

A huge amount can be learned from reading other peopleβs code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

• What compromises have been made?
• Are there new concepts here that you could read more about to improve your understanding?