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.

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')]

[Test]
[Ignore]

[Test]
[Ignore]

[Test]
[Ignore]

[Test]
[Ignore]

[Test]
[Ignore]
procedure full_buffer_cannot_be_written_to;

[Test]
[Ignore]

[Test]
[Ignore]

[Test]
[Ignore]

[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]
end;

implementation
uses System.SysUtils, uCircularBuffer;

var MyBuffer: ICircularBuffer<char>;
Actual: char;
begin
MyBuffer := TCircularBuffer<char>.Create(1);
MyBuffer.Write('1');
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);

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);

Assert.AreEqual(2, Actual);
end;

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

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

MyProc := procedure
begin
end;

Assert.WillRaise(MyProc, EInvalidOpException);
end;

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

MyBuffer.Write('1');

MyBuffer.Clear;

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

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

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

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

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

MyBuffer.Write('3');

Assert.AreEqual('2',Actual);
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);

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

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

Assert.AreEqual(1,Actual);

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

Assert.AreEqual(3,Actual);
Assert.AreEqual(4,Actual);
Assert.AreEqual(5,Actual);
end;

var MyBuffer: ICircularBuffer<integer>;
MyProc: TTestLocalMethod;
begin
MyBuffer := TCircularBuffer<integer>.create(2);
MyProc := procedure
begin
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');

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

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

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}']
procedure Write(aItem: T);
procedure OverWrite(aItem: T);
procedure Clear;
end;

TCircularBuffer<T> = class(TInterfacedObject,ICircularBuffer<T>)
private
FBuffer: TQueue<T>;
public
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;

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.``````