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

# dgeiger's solution

## to Circular Buffer in the Delphi Pascal Track

Published at Sep 24 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, System.SysUtils;

type
ICircularBuffer<Char> = interface['{C3D9998D-ECF4-4BC9-8A2F-E4812D56EE05}']

procedure Clear;
procedure OverWrite(Value: Char);
procedure Write(Value: Char);

end;

TCircularBuffer<Char> = class(TInterfacedObject, ICircularBuffer<Char>)
private
FBuffer: TArray<Char>;
FCount: Integer;
FEnd: Integer;
FSize: Integer;
FStart: Integer;
//      FCurrent: Integer;

function FNext(Pointer: Integer): Integer;

public
constructor Create(BufferSize: Integer);

procedure Clear;
procedure OverWrite(Value: Char);
procedure Write(Value: Char);

end;

implementation

{ TCircularBuffer<char> }

procedure TCircularBuffer<Char>.Clear;
begin
// Set the variables to show that the buffer starts at zero, has no
// entries, and, therefore, the end position is the same as the start
FStart   := Low(FBuffer);
FEnd     := Low(FBuffer);
FCount   := 0;
end;

constructor TCircularBuffer<Char>.Create(BufferSize: Integer);
begin
// Save the buffer size
FSize := BufferSize;

// Create the buffer
SetLength(FBuffer, FSize);

// and clear the buffer
Clear;
end;

function TCircularBuffer<Char>.FNext(Pointer: Integer): Integer;
begin
// Get the next pointer into the buffer
Result := Succ(Pointer);

// If we're past theend of the buffer,
if Result > High(FBuffer) then
// wrap around to the beginning
Result := Low(FBuffer);
end;

procedure TCircularBuffer<Char>.OverWrite(Value: Char);
begin
// If the buffer isn't full, just do a normal write
if FCount < FSize then
Write(Value)
else
// Otherwise, forcibly overwrite the first entry, and
// move the start position to the next entry.
begin
FBuffer[FStart] := Value;

FStart := FNext(FStart);
end;
end;

begin
// If there are no buffer entries, throw an exception
if FCount = 0 then
raise EInvalidOpException.Create('buffer is empty');

// Get the entry
Result := FBuffer[FStart];

// Decrement the entry count
FCount := Pred(FCount);

// If we've run out of entries, mark the buffer as empty
if FCount = 0 then
Clear
else
// Otherwise, move the start pointer to the next position
FStart := FNext(FStart);
end;

procedure TCircularBuffer<Char>.Write(Value: Char);
begin
// If the buffer is full, throw an exception
if FCount = FSize then
raise EInvalidOpException.Create('buffer is full');

// Otherwise, increment the entry count,
Inc(FCount);

// store the entry in the buffer,
FBuffer[FEnd] := Value;

// and update the end pointer.
FEnd := FNext(FEnd);
end;

end.``````