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

# Sarahhuik's solution

## to Circular Buffer in the Delphi Pascal Track

Published at Aug 20 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 Generics.Collections, System.Generics.Defaults;

type
ICircularBuffer<T> = interface
procedure Write(const ToWrite: T);
procedure overwrite(const ToWrite : T);
procedure clear;
end;  // ICircularBuffer interface

type
TCircularBuffer<T> = class(TInterfacedObject, ICircularBuffer<T>)
private
Buffer : array of T;
NbOfCells, Current, Oldest : Integer;
BufferFull : Boolean;
Compare: IEqualityComparer<T>;
procedure AssignAndIncrement(var iValue : Integer ; const ToWrite : T);
procedure Init;
public
procedure Write(const ToWrite: T);
procedure overwrite(const ToWrite : T);
procedure clear;
constructor Create(const iNbOfCells : Integer);
destructor Destroy; override;
end; // TCircularBuffer class

implementation

uses System.SysUtils;

constructor TCircularBuffer<T>.Create(const iNbOfCells : Integer);
begin
NbOfCells := iNbOfCells;

Compare := TEqualityComparer<T>.Default;  // To compare Nil object
// Default(T) = nil = nothing in cell
SetLength(Buffer, iNbOfCells);
Current := 0;  // Start at first cell
Init           // Init all values
End;

destructor TCircularBuffer<T>.Destroy;
begin
Buffer := nil;
inherited
end;

var TResult : T;
begin
// If oldest item is equal to nil => this is an empty buffer and it can't be read
if (Compare.Equals(Buffer[Oldest], default(T))) then
raise EInvalidOpException.Create('You''re trying to read an empty circular Buffer');

TResult := Buffer[Oldest];
AssignAndIncrement(Oldest, default(T));
BufferFull := False; // Buffer is no longer full

result := TResult
end;

procedure TCircularBuffer<T>.Write(const ToWrite: T);
begin
if (BufferFull) then
raise EInvalidOpException.Create('You''re trying to write in a full circular Buffer');

AssignAndIncrement(Current, ToWrite);

if (Oldest = Current) then
BufferFull := True
end;

procedure TCircularBuffer<T>.overwrite(const ToWrite : T);
begin
if not BufferFull then
Write(ToWrite)
else
AssignAndIncrement(oldest, ToWrite)
end;

procedure TCircularBuffer<T>.AssignAndIncrement(var iValue : Integer ; const ToWrite : T);
begin
Buffer[iValue] := ToWrite;
iValue := (iValue + 1) mod NbOfCells // mod => to have a circular buffer, we go back to beginning of the array
end;

procedure TCircularBuffer<T>.clear;
begin
Init
end;

procedure TCircularBuffer<T>.Init;
var
i: Integer;
begin
Oldest := Current; // 0 if First time, whatever if nth time
BufferFull := False;

for i := Low(Buffer) to High(Buffer) do
Buffer[i] := Default(T) // assign nil, i.e: nothing in cell
end;

end.``````