Units renamed & Chart refactored
This commit is contained in:
Michael Schimmel
@@ -4,7 +4,7 @@
|
||||
<ProjectVersion>20.3</ProjectVersion>
|
||||
<FrameworkType>FMX</FrameworkType>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">Release</Config>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win64</Platform>
|
||||
<ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName>
|
||||
<TargetedPlatforms>3</TargetedPlatforms>
|
||||
|
||||
@@ -6,7 +6,7 @@ uses
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.TaskManager,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataPoint,
|
||||
|
||||
@@ -32,7 +32,7 @@ uses
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Trade.DataProvider,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Signals.FMX,
|
||||
Myc.TaskManager,
|
||||
Myc.Aura.Module,
|
||||
|
||||
@@ -164,7 +164,7 @@ uses
|
||||
System.Generics.Collections,
|
||||
Myc.Signals,
|
||||
Myc.Futures,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Aura.Parameter;
|
||||
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
unit Myc.Core.Futures;
|
||||
unit Myc.Core.Future;
|
||||
|
||||
interface
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
unit Myc.Core.Lazy;
|
||||
unit Myc.Core.Mutable;
|
||||
|
||||
interface
|
||||
|
||||
@@ -7,7 +7,7 @@ uses
|
||||
System.SysUtils,
|
||||
System.SyncObjs,
|
||||
Myc.Signals,
|
||||
Myc.Lazy;
|
||||
Myc.Mutable;
|
||||
|
||||
type
|
||||
TMycNullMutable<T> = class(TInterfacedObject, TMutable<T>.IMutable)
|
||||
@@ -47,7 +47,6 @@ type
|
||||
protected
|
||||
function GetChanged: TSignal;
|
||||
function GetValue: T;
|
||||
function Exchange(const Value: T): T;
|
||||
public
|
||||
constructor Create(const AValue: T);
|
||||
procedure SetValue(const Value: T);
|
||||
@@ -58,7 +57,6 @@ type
|
||||
FWriteable: TWriteable<T>.IWriteable;
|
||||
FLock: TLightweightMREW;
|
||||
protected
|
||||
function Exchange(const Value: T): T;
|
||||
function GetChanged: TSignal;
|
||||
function GetValue: T;
|
||||
public
|
||||
@@ -118,12 +116,6 @@ begin
|
||||
FChanged := TEvent.CreateEvent;
|
||||
end;
|
||||
|
||||
function TMycWriteableMutable<T>.Exchange(const Value: T): T;
|
||||
begin
|
||||
Result := FValue;
|
||||
FValue := Value;
|
||||
end;
|
||||
|
||||
function TMycWriteableMutable<T>.GetChanged: TSignal;
|
||||
begin
|
||||
Result := FChanged.Signal;
|
||||
@@ -162,16 +154,6 @@ begin
|
||||
FWriteable := AWriteable;
|
||||
end;
|
||||
|
||||
function TMycProtectedMutable<T>.Exchange(const Value: T): T;
|
||||
begin
|
||||
FLock.BeginWrite;
|
||||
try
|
||||
Result := FWriteable.Exchange(Value);
|
||||
finally
|
||||
FLock.EndWrite;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMycProtectedMutable<T>.GetChanged: TSignal;
|
||||
begin
|
||||
Result := FWriteable.Changed;
|
||||
@@ -8,7 +8,7 @@ uses
|
||||
System.UITypes,
|
||||
FMX.Graphics,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataArray,
|
||||
Myc.Trade.DataPoint,
|
||||
|
||||
+52
-81
@@ -18,7 +18,7 @@ uses
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Signals,
|
||||
Myc.Lazy;
|
||||
Myc.Mutable;
|
||||
|
||||
type
|
||||
TMycChart = class(TStyledControl)
|
||||
@@ -59,18 +59,14 @@ type
|
||||
constructor Create(AParent: TPanel);
|
||||
end;
|
||||
|
||||
TAxisLayer = class(TLayer)
|
||||
TAxisLayer = class abstract(TLayer)
|
||||
private
|
||||
FOwner: TMycChart;
|
||||
protected
|
||||
function GetOwner: TMycChart; override; final;
|
||||
// Paint crosshair and other axis related overlays
|
||||
procedure Paint(
|
||||
const Canvas: TCanvas;
|
||||
const Viewport: TRectF;
|
||||
ViewStartIndex, ViewCount: Int64;
|
||||
const MousePos: TPointF
|
||||
); virtual;
|
||||
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos: Integer); virtual;
|
||||
abstract;
|
||||
public
|
||||
constructor Create(AOwner: TMycChart);
|
||||
end;
|
||||
@@ -78,12 +74,7 @@ type
|
||||
TXAxisLayer = class(TAxisLayer)
|
||||
protected
|
||||
// Paint crosshair and time caption
|
||||
procedure Paint(
|
||||
const Canvas: TCanvas;
|
||||
const Viewport: TRectF;
|
||||
ViewStartIndex, ViewCount: Int64;
|
||||
const MousePos: TPointF
|
||||
); override;
|
||||
procedure Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos: Integer); override;
|
||||
// This function delivers the text for the caption.
|
||||
function GetCaption(Idx: Int64): String; virtual; abstract;
|
||||
end;
|
||||
@@ -119,6 +110,11 @@ type
|
||||
property Weight: Single read FWeight write SetWeight;
|
||||
end;
|
||||
|
||||
TDragPoint = record
|
||||
Point: TPointF;
|
||||
Idx: Int64;
|
||||
end;
|
||||
|
||||
private
|
||||
FPanelList: TObjectList<TPanel>;
|
||||
FXAxisSeries: TMycChart.TXAxisLayer;
|
||||
@@ -127,8 +123,8 @@ type
|
||||
FViewStartIndex: Int64;
|
||||
FViewCount: Int64;
|
||||
FIsDragging: Boolean;
|
||||
FDragStartPoint: TPointF;
|
||||
FMousePos: TPointF;
|
||||
FMousePos: TDragPoint;
|
||||
FDragStartPoint: TDragPoint;
|
||||
FIsMouseInControl: Boolean;
|
||||
FJumpButtonRect: TRectF;
|
||||
FJumpButtonHot: Boolean;
|
||||
@@ -139,6 +135,7 @@ type
|
||||
FHotResizePanelIndex: Integer;
|
||||
function GetPanel(Index: Integer): TPanel;
|
||||
function GetPanelCount: Integer;
|
||||
function CreateDragPoint(X, Y: Single): TDragPoint;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure DoIdle;
|
||||
@@ -221,6 +218,15 @@ begin
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
function TMycChart.CreateDragPoint(X, Y: Single): TDragPoint;
|
||||
begin
|
||||
Result.Point.X := X;
|
||||
Result.Point.Y := Y;
|
||||
Result.Idx := Round((LocalRect.Right - X) * (FViewCount - 1) / LocalRect.Width);
|
||||
if (Result.Idx < 0) or (Result.Idx >= FXAxisSeries.Series.Count) then
|
||||
Result.Idx := -1;
|
||||
end;
|
||||
|
||||
function TMycChart.GetPanel(Index: Integer): TPanel;
|
||||
begin
|
||||
Result := FPanelList[Index];
|
||||
@@ -333,8 +339,12 @@ begin
|
||||
end;
|
||||
|
||||
// Draw crosshair if mouse is in control
|
||||
if FIsMouseInControl and Assigned(FXAxisSeries) and not FIsDragging and not FIsResizing then
|
||||
FXAxisSeries.Paint(Self.Canvas, rect, FViewStartIndex, FViewCount, FMousePos);
|
||||
if FIsMouseInControl and Assigned(FXAxisSeries) and (FMousePos.Idx >= 0 ) then
|
||||
begin
|
||||
// Do not draw crosshair if mouse is over the jump button
|
||||
if not FJumpButtonRect.Contains(FMousePos.Point) then
|
||||
FXAxisSeries.Paint(Self.Canvas, rect, FViewStartIndex, FViewCount, FViewStartIndex + FMousePos.Idx );
|
||||
end;
|
||||
|
||||
// --- Draw the "jump to latest" button (code unchanged) ---
|
||||
isButtonVisible := (FViewStartIndex > 0);
|
||||
@@ -380,6 +390,8 @@ end;
|
||||
|
||||
procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
|
||||
// Check for button press first
|
||||
if (Button = TMouseButton.mbLeft) and (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then
|
||||
begin
|
||||
@@ -393,16 +405,15 @@ begin
|
||||
begin
|
||||
FIsResizing := true;
|
||||
FResizePanelIndex := FHotResizePanelIndex;
|
||||
FDragStartPoint := TPointF.Create(X, Y);
|
||||
FDragStartPoint := CreateDragPoint(X, Y);
|
||||
Capture;
|
||||
exit;
|
||||
end;
|
||||
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if (Button = TMouseButton.mbLeft) then
|
||||
begin
|
||||
FIsDragging := true;
|
||||
FDragStartPoint := TPointF.Create(X, Y);
|
||||
FDragStartPoint := CreateDragPoint(X, Y);
|
||||
Capture;
|
||||
end;
|
||||
end;
|
||||
@@ -427,10 +438,7 @@ begin
|
||||
end;
|
||||
|
||||
// Stop panning
|
||||
if FIsDragging then
|
||||
begin
|
||||
FIsDragging := false;
|
||||
end;
|
||||
|
||||
// Stop button press
|
||||
if FJumpButtonPressed then
|
||||
@@ -459,12 +467,14 @@ begin
|
||||
|
||||
if not FIsMouseInControl then
|
||||
FIsMouseInControl := true;
|
||||
FMousePos := TPointF.Create(X, Y);
|
||||
FMousePos := CreateDragPoint(X, Y);
|
||||
|
||||
// --- Panel Resizing Logic ---
|
||||
if FIsResizing then
|
||||
begin
|
||||
dy := Y - FDragStartPoint.Y;
|
||||
dy := Y - FDragStartPoint.Point.Y;
|
||||
if Abs(dx) < 2 then // Threshold to avoid jitter
|
||||
exit;
|
||||
|
||||
var panel1 := Panels[FResizePanelIndex];
|
||||
var panel2 := Panels[FResizePanelIndex + 1];
|
||||
@@ -502,7 +512,7 @@ begin
|
||||
panel2.Weight := (newH2 / (newH1 + newH2)) * twoPanelWeight;
|
||||
end;
|
||||
|
||||
FDragStartPoint.Y := Y; // Update start point for next move
|
||||
FDragStartPoint := CreateDragPoint( FDragStartPoint.Point.X, Y ); // Update start point for next move
|
||||
Repaint;
|
||||
exit; // Do not continue with other mouse move logic
|
||||
end;
|
||||
@@ -510,17 +520,17 @@ begin
|
||||
// --- Chart Panning Logic ---
|
||||
if FIsDragging then
|
||||
begin
|
||||
dx := X - FDragStartPoint.X;
|
||||
dx := X - FDragStartPoint.Point.X;
|
||||
if Abs(dx) < 2 then // Threshold to avoid jitter
|
||||
begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not Assigned(FXAxisSeries) or (FViewCount <= 0) then
|
||||
exit;
|
||||
|
||||
indexDelta := Round(dx / (Self.Width / FViewCount));
|
||||
FViewStartIndex := FViewStartIndex + indexDelta;
|
||||
indexDelta := FMousePos.Idx - FDragStartPoint.Idx;
|
||||
FDragStartPoint.Idx := FDragStartPoint.Idx + indexDelta;
|
||||
|
||||
FViewStartIndex := FViewStartIndex - indexDelta;
|
||||
|
||||
// Clamp values
|
||||
maxIndex := FXAxisSeries.Series.Count - FViewCount;
|
||||
@@ -531,8 +541,6 @@ begin
|
||||
if (FViewStartIndex > maxIndex) then
|
||||
FViewStartIndex := maxIndex;
|
||||
|
||||
FDragStartPoint.X := X;
|
||||
FDragStartPoint.Y := Y;
|
||||
Repaint;
|
||||
exit;
|
||||
end;
|
||||
@@ -574,12 +582,11 @@ end;
|
||||
|
||||
procedure TMycChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
var
|
||||
mousePos: TPointF;
|
||||
anchorIndex: Double;
|
||||
zoomFactor: Double;
|
||||
newViewCount: Int64;
|
||||
ratio: Double;
|
||||
begin
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
|
||||
Handled := true;
|
||||
|
||||
// An X-axis series is required for zooming
|
||||
@@ -590,11 +597,6 @@ begin
|
||||
if (xAxisCount = 0) or (Width <= 0) then
|
||||
exit;
|
||||
|
||||
mousePos := ScreenToLocal(Screen.MousePos);
|
||||
|
||||
// Calculate the anchor index for a right-to-left axis
|
||||
anchorIndex := FViewStartIndex + ((Self.Width - mousePos.X) / Self.Width) * FViewCount;
|
||||
|
||||
if (WheelDelta > 0) then
|
||||
zoomFactor := 0.8 // Zoom In
|
||||
else
|
||||
@@ -610,15 +612,12 @@ begin
|
||||
if (newViewCount = FViewCount) then
|
||||
exit;
|
||||
|
||||
// Adjust start index to keep anchor point stable
|
||||
if (FViewCount > 0) then
|
||||
ratio := (anchorIndex - FViewStartIndex) / FViewCount
|
||||
else
|
||||
ratio := 0;
|
||||
|
||||
FViewStartIndex := Round(anchorIndex - (ratio * newViewCount));
|
||||
FViewCount := newViewCount;
|
||||
|
||||
var oldIdx := FViewStartIndex + FMousePos.Idx;
|
||||
FMousePos := CreateDragPoint( FMousePos.Point.X, FMousePos.Point.Y );
|
||||
FViewStartIndex := oldIdx - FMousePos.Idx;
|
||||
|
||||
// Clamp start index
|
||||
if (FViewStartIndex < 0) then
|
||||
FViewStartIndex := 0;
|
||||
@@ -818,51 +817,23 @@ begin
|
||||
Result := FOwner;
|
||||
end;
|
||||
|
||||
procedure TMycChart.TAxisLayer.Paint(
|
||||
const Canvas: TCanvas;
|
||||
const Viewport: TRectF;
|
||||
ViewStartIndex, ViewCount: Int64;
|
||||
const MousePos: TPointF
|
||||
);
|
||||
begin
|
||||
// Do nothing in base class
|
||||
end;
|
||||
|
||||
{ TMycChart.TXAxisLayer }
|
||||
|
||||
procedure TMycChart.TXAxisLayer.Paint(
|
||||
const Canvas: TCanvas;
|
||||
const Viewport: TRectF;
|
||||
ViewStartIndex, ViewCount: Int64;
|
||||
const MousePos: TPointF
|
||||
);
|
||||
procedure TMycChart.TXAxisLayer.Paint(const Canvas: TCanvas; const Viewport: TRectF; ViewStartIndex, ViewCount: Int64; IdxAtMousePos:
|
||||
Integer);
|
||||
var
|
||||
idx: Int64;
|
||||
caption: string;
|
||||
captionRect: TRectF;
|
||||
padding: Single;
|
||||
indexFromMouse: Double;
|
||||
candleX: Single;
|
||||
textSize: TRectF;
|
||||
begin
|
||||
// Do not draw crosshair if mouse is over the jump button
|
||||
if Owner.JumpButtonRect.Contains(MousePos) then
|
||||
exit;
|
||||
|
||||
// Do not draw if no data or view is invalid
|
||||
if (not Assigned(Series)) or (Series.Count = 0) or (ViewCount <= 1) then
|
||||
exit;
|
||||
|
||||
// 1. Calculate the data index from the mouse X position
|
||||
indexFromMouse := ViewStartIndex + (Viewport.Right - MousePos.X) * (ViewCount - 1) / Viewport.Width;
|
||||
idx := Round(indexFromMouse);
|
||||
|
||||
// Check if the calculated index is valid for the series
|
||||
if (idx < 0) or (idx >= Series.Count) then
|
||||
exit;
|
||||
|
||||
// Snap X to the candle's center
|
||||
candleX := Viewport.Right - ((idx - ViewStartIndex) * (ViewCount - 1)) / (ViewCount - 1) * (Viewport.Width / (ViewCount - 1));
|
||||
candleX := Viewport.Right - ((IdxAtMousePos - ViewStartIndex) * (ViewCount - 1)) / (ViewCount - 1) * (Viewport.Width / (ViewCount - 1));
|
||||
|
||||
// 2. Draw the vertical line at the snapped position
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
@@ -871,7 +842,7 @@ begin
|
||||
Canvas.DrawLine(PointF(candleX, Viewport.Top), PointF(candleX, Viewport.Bottom), 1.0);
|
||||
|
||||
// 3. Get the caption for the index
|
||||
caption := GetCaption(idx);
|
||||
caption := GetCaption(IdxAtMousePos);
|
||||
if caption.IsEmpty then
|
||||
exit;
|
||||
|
||||
|
||||
+1
-1
@@ -86,7 +86,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Core.Futures;
|
||||
Myc.Core.Future;
|
||||
|
||||
constructor TFuture<T>.Create(const AFuture: IFuture);
|
||||
begin
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
unit Myc.Lazy;
|
||||
unit Myc.Mutable;
|
||||
|
||||
interface
|
||||
|
||||
@@ -48,7 +48,6 @@ type
|
||||
type
|
||||
IWriteable = interface(TMutable<T>.IMutable)
|
||||
procedure SetValue(const Value: T);
|
||||
function Exchange(const Value: T): T;
|
||||
end;
|
||||
|
||||
{$REGION 'private'}
|
||||
@@ -67,7 +66,6 @@ type
|
||||
class function CreateWriteable(const Init: T): TWriteable<T>; overload; static;
|
||||
|
||||
function Protect: TWriteable<T>;
|
||||
|
||||
function AsMutable: TMutable<T>;
|
||||
|
||||
property Value: T read GetValue write SetValue;
|
||||
@@ -89,7 +87,7 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Core.Lazy;
|
||||
Myc.Core.Mutable;
|
||||
|
||||
{ TMutable<T> }
|
||||
|
||||
@@ -201,7 +199,6 @@ constructor TLazy<T>.Create(const AMutable: TMutable<T>);
|
||||
begin
|
||||
FMutable := AMutable;
|
||||
FChanged := TFlag.CreateFlag;
|
||||
FChanged.Notify;
|
||||
FChangeState := AMutable.Changed.Subscribe(FChanged);
|
||||
end;
|
||||
|
||||
@@ -1,439 +0,0 @@
|
||||
unit Myc.Test.Core.Lazy;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals, // For IMycState, TState, IMycDirty
|
||||
Myc.Lazy, // For IMycLazy<T>
|
||||
Myc.Core.Lazy; // Unit to be tested
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestMycCoreLazy = class(TObject)
|
||||
private
|
||||
procedure Helper_ConsumeInitialPop(const ALazy: TLazy<Integer>.ILazy; InitialExpectedValue: Integer); overload;
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
[TearDown]
|
||||
procedure TearDown;
|
||||
|
||||
// Tests for TMycNullLazy<T>
|
||||
[Test]
|
||||
procedure TestNullLazy_GetChanged_IsAlwaysNullState;
|
||||
[Test]
|
||||
procedure TestNullLazy_Pop_ReturnsDefaultIntegerAndTrue;
|
||||
[Test]
|
||||
procedure TestNullLazy_Pop_ReturnsDefaultStringAndTrue;
|
||||
[Test]
|
||||
procedure TestNullLazy_Pop_ReturnsDefaultInterfaceAndTrue;
|
||||
|
||||
// Tests for TMycFuncLazy<T> reflecting "IsSet is true by design after creation"
|
||||
[Test]
|
||||
procedure TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation;
|
||||
[Test]
|
||||
procedure TestFuncLazy_FirstPop_AlwaysEvaluatesAndResetsChanged;
|
||||
// Tests for behavior after the initial "changed" state is consumed
|
||||
[Test]
|
||||
procedure TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
|
||||
[Test]
|
||||
procedure TestFuncLazy_AfterFirstPop_IfNoSourceChange_PopReturnsFalse_ValueUndefined;
|
||||
[Test]
|
||||
procedure TestFuncLazy_AfterSourceChange_GetChanged_IsSet;
|
||||
[Test]
|
||||
procedure TestFuncLazy_AfterSourceChange_Pop_ReturnsTrueAndProcResult_ResetsChanged;
|
||||
|
||||
[Test]
|
||||
procedure TestFuncLazy_Pop_Twice_SourceUnchanged_SecondPopReturnsFalse_ValueUndefined;
|
||||
// This test is now significantly changed to reflect TMycDirty's notification behavior
|
||||
[Test]
|
||||
procedure TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy;
|
||||
[Test]
|
||||
procedure TestFuncLazy_Destroy_UnsubscribesFromSource;
|
||||
[Test]
|
||||
procedure TestFuncLazy_SourceIsInitiallySet_PopBehavesCorrectly;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Rtti,
|
||||
Myc.Core.Signals;
|
||||
|
||||
{ TTestMycCoreLazy Helper Methods }
|
||||
|
||||
procedure TTestMycCoreLazy.Helper_ConsumeInitialPop(const ALazy: TLazy<Integer>.ILazy; InitialExpectedValue: Integer);
|
||||
var
|
||||
tempValue: Integer;
|
||||
popResult: Boolean;
|
||||
begin
|
||||
Assert.IsTrue(ALazy.GetChanged.IsSet, 'Changed.IsSet should be true before consuming initial pop');
|
||||
popResult := ALazy.Pop(tempValue);
|
||||
Assert.IsTrue(popResult, 'Consuming initial Pop should return true');
|
||||
Assert.AreEqual(InitialExpectedValue, tempValue, 'Value from initial Pop is unexpected');
|
||||
Assert.IsFalse(ALazy.GetChanged.IsSet, 'Changed.IsSet should be false after consuming initial pop');
|
||||
end;
|
||||
|
||||
{ TTestMycCoreLazy Test Methods }
|
||||
|
||||
procedure TTestMycCoreLazy.Setup;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TearDown;
|
||||
begin
|
||||
end;
|
||||
|
||||
// == Tests for TMycNullLazy<T> ==
|
||||
procedure TTestMycCoreLazy.TestNullLazy_GetChanged_IsAlwaysNullState;
|
||||
var
|
||||
nullLazy: TLazy<Integer>.ILazy;
|
||||
changedState: TState.IState;
|
||||
begin
|
||||
nullLazy := TMycNullLazy<Integer>.Create as TLazy<Integer>.ILazy;
|
||||
Assert.IsNotNull(nullLazy, 'TMycNullLazy<Integer> instance should not be nil');
|
||||
changedState := nullLazy.GetChanged;
|
||||
Assert.AreSame(TState.Null, changedState, 'TMycNullLazy.GetChanged should return TState.Null');
|
||||
Assert.IsTrue(changedState.IsSet, 'TState.Null should always be set');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultIntegerAndTrue;
|
||||
var
|
||||
nullLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
begin
|
||||
nullLazy := TMycNullLazy<Integer>.Create as TLazy<Integer>.ILazy;
|
||||
Assert.IsNotNull(nullLazy, 'TMycNullLazy<Integer> instance should not be nil');
|
||||
value := 123;
|
||||
result := nullLazy.Pop(value);
|
||||
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
|
||||
Assert.AreEqual(Default(Integer), value, 'Value should be Default(Integer) after Pop');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultStringAndTrue;
|
||||
var
|
||||
nullLazy: TLazy<String>.ILazy;
|
||||
value: string;
|
||||
result: Boolean;
|
||||
begin
|
||||
nullLazy := TMycNullLazy<string>.Create as TLazy<String>.ILazy;
|
||||
Assert.IsNotNull(nullLazy, 'TMycNullLazy<string> instance should not be nil');
|
||||
value := 'test';
|
||||
result := nullLazy.Pop(value);
|
||||
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
|
||||
Assert.AreEqual(Default(string), value, 'Value should be Default(string) after Pop');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestNullLazy_Pop_ReturnsDefaultInterfaceAndTrue;
|
||||
var
|
||||
nullLazy: TLazy<TState.IState>.ILazy;
|
||||
value: TState.IState;
|
||||
result: Boolean;
|
||||
begin
|
||||
nullLazy := TMycNullLazy<TState.IState>.Create as TLazy<TState.IState>.ILazy;
|
||||
Assert.IsNotNull(nullLazy, 'TMycNullLazy<TState.IState> instance should not be nil');
|
||||
value := TState.Null;
|
||||
result := nullLazy.Pop(value);
|
||||
Assert.IsTrue(result, 'TMycNullLazy.Pop should return true');
|
||||
Assert.IsNull(value, 'Value should be nil for an interface type after Pop from NullLazy');
|
||||
end;
|
||||
|
||||
// == Tests for TMycFuncLazy<T> - Initial State by Design ==
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
changedState: TState.IState;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State.Signal, function: Integer begin Result := 10; end);
|
||||
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
|
||||
changedState := funcLazy.GetChanged;
|
||||
Assert.IsNotNull(changedState, 'funcLazy.GetChanged should return a valid TState.IState');
|
||||
Assert.IsTrue(changedState.IsSet, 'By design, funcLazy.GetChanged.IsSet should be true immediately after creation');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_FirstPop_AlwaysEvaluatesAndResetsChanged;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
procExecuted: Boolean;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
procExecuted := False;
|
||||
expectedValue := 50;
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
procExecuted := True;
|
||||
Result := expectedValue;
|
||||
end
|
||||
);
|
||||
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
|
||||
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be true before the first Pop by design');
|
||||
value := 0;
|
||||
result := funcLazy.Pop(value);
|
||||
Assert.IsTrue(result, 'The first Pop should return true by design, indicating evaluation');
|
||||
Assert.IsTrue(procExecuted, 'FProc should have been executed on the first Pop');
|
||||
Assert.AreEqual(expectedValue, value, 'Value should be the result from FProc after the first Pop');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed.IsSet should be false after the first Pop, as Pop resets it');
|
||||
end;
|
||||
|
||||
// == Tests for TMycFuncLazy<T> - Behavior After Initial Pop ==
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
initialProcValue: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
initialProcValue := 33;
|
||||
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State.Signal, function: Integer begin Result := initialProcValue; end);
|
||||
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'After initial Pop and no source change, GetChanged.IsSet should be false');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_PopReturnsFalse_ValueUndefined;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
initialProcValue: Integer;
|
||||
procExecutedCount: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
initialProcValue := 44;
|
||||
procExecutedCount := 0;
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procExecutedCount);
|
||||
Result := initialProcValue;
|
||||
end
|
||||
);
|
||||
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
|
||||
Assert.AreEqual(1, procExecutedCount, 'Proc should have executed once for initial pop');
|
||||
result := funcLazy.Pop(value);
|
||||
Assert.IsFalse(result, 'Second Pop (after initial, no source change) should return false');
|
||||
Assert.AreEqual(1, procExecutedCount, 'Proc should not have executed again');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_AfterSourceChange_GetChanged_IsSet;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
changedState: TState.IState;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
initialProcValue: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
initialProcValue := 20;
|
||||
funcLazy := TMycFuncLazy<Integer>.Create(sourceDirty.State.Signal, function: Integer begin Result := initialProcValue; end);
|
||||
Helper_ConsumeInitialPop(funcLazy, initialProcValue);
|
||||
sourceDirty.Notify;
|
||||
changedState := funcLazy.GetChanged;
|
||||
Assert.IsTrue(changedState.IsSet, 'After source change (post-initial pop), funcLazy.GetChanged.IsSet should be true');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_AfterSourceChange_Pop_ReturnsTrueAndProcResult_ResetsChanged;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
procCallCount: Integer;
|
||||
currentExpectedValue: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
procCallCount := 0;
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
if procCallCount = 1 then
|
||||
Result := 30
|
||||
else
|
||||
Result := 300 + procCallCount;
|
||||
end
|
||||
);
|
||||
currentExpectedValue := 30;
|
||||
Helper_ConsumeInitialPop(funcLazy, currentExpectedValue);
|
||||
Assert.AreEqual(1, procCallCount, 'Proc executed for initial Pop');
|
||||
sourceDirty.Notify;
|
||||
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true after source notification');
|
||||
value := 0;
|
||||
result := funcLazy.Pop(value);
|
||||
currentExpectedValue := 300 + 2;
|
||||
Assert.IsTrue(result, 'Pop should return true after source changed');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc should have been executed again');
|
||||
Assert.AreEqual(currentExpectedValue, value, 'Value should be the new result of FProc');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after Pop');
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_Pop_Twice_SourceUnchanged_SecondPopReturnsFalse_ValueUndefined;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
resultPop1, resultPop2: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
procCallCount: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
procCallCount := 0;
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
Result := 40;
|
||||
end
|
||||
);
|
||||
resultPop1 := funcLazy.Pop(value);
|
||||
Assert.IsTrue(resultPop1, 'First Pop should return true by design');
|
||||
Assert.AreEqual(40, value, 'Value from first Pop');
|
||||
Assert.AreEqual(1, procCallCount, 'Proc called for first Pop');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after first Pop');
|
||||
resultPop2 := funcLazy.Pop(value);
|
||||
Assert.IsFalse(resultPop2, 'Second Pop should return false as state was reset and not changed again by source');
|
||||
Assert.AreEqual(1, procCallCount, 'Proc should not be called for second Pop if no source change');
|
||||
end;
|
||||
|
||||
// TestFuncLazy_SourceChanges_Pop_SourceChangesAgain_PopAgain has been RENAMED and RESTRUCTURED
|
||||
// to TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_SourceInteraction_NotifyOnSetSourceDoesNotRetriggerLazy;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
procCallCount: Integer;
|
||||
initialValue, firstSourceChangeValue: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset; // sourceDirty.IsSet is FALSE
|
||||
procCallCount := 0;
|
||||
initialValue := 51;
|
||||
firstSourceChangeValue := 52;
|
||||
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
if procCallCount = 1 then
|
||||
Result := initialValue // For initial pop
|
||||
else if procCallCount = 2 then
|
||||
Result := firstSourceChangeValue // For pop after first effective source change
|
||||
else
|
||||
Result := 999; // Should not be reached in this specific test logic
|
||||
end
|
||||
);
|
||||
|
||||
// 1. Initial Pop (consumes "by design" changed state)
|
||||
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true before first Pop (by design)');
|
||||
result := funcLazy.Pop(value); // procCallCount becomes 1
|
||||
Assert.IsTrue(result, 'First Pop should return true');
|
||||
Assert.AreEqual(initialValue, value, 'Value from first Pop');
|
||||
Assert.AreEqual(1, procCallCount, 'Proc called for initial Pop');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after first Pop');
|
||||
|
||||
// 2. First effective source change (sourceDirty: false -> true)
|
||||
sourceDirty.Notify; // sourceDirty.IsSet becomes TRUE, notifies funcLazy.FChanged, funcLazy.GetChanged.IsSet becomes TRUE
|
||||
Assert.IsTrue(sourceDirty.State.IsSet, 'sourceDirty should be set after first Notify');
|
||||
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'Changed state should be true after first effective source notification');
|
||||
result := funcLazy.Pop(value); // procCallCount becomes 2
|
||||
Assert.IsTrue(result, 'Pop after first effective source change should return true');
|
||||
Assert.AreEqual(firstSourceChangeValue, value, 'Value from Pop after first effective source change');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc called again');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after second Pop');
|
||||
|
||||
// 3. Notify sourceDirty again (sourceDirty is already TRUE)
|
||||
Assert.IsTrue(sourceDirty.State.IsSet, 'sourceDirty is still set before second Notify attempt');
|
||||
sourceDirty.Notify; // Since sourceDirty is already set, this does NOT notify funcLazy.FChanged.
|
||||
// funcLazy.GetChanged.IsSet remains FALSE.
|
||||
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should REMAIN false after Notify on an already-set source');
|
||||
|
||||
// 4. Attempt to Pop again
|
||||
result := funcLazy.Pop(value); // procCallCount should remain 2
|
||||
Assert.IsFalse(result, 'Pop after Notify on an already-set source should return false');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc should NOT have been called again');
|
||||
// Value of 'value' is undefined here and not checked.
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_Destroy_UnsubscribesFromSource;
|
||||
var
|
||||
funcLazyObj: TMycFuncLazy<Integer>;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
tempVal: Integer;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag;
|
||||
sourceDirty.Reset;
|
||||
funcLazyObj := TMycFuncLazy<Integer>.Create(sourceDirty.State.Signal, function: Integer begin Result := 1; end);
|
||||
Assert.IsTrue(funcLazyObj.Pop(tempVal), 'Initial Pop should succeed');
|
||||
funcLazyObj.Destroy;
|
||||
Assert.WillNotRaise(
|
||||
procedure begin sourceDirty.Notify; end,
|
||||
nil,
|
||||
'Destroy test assumes TMycSubscription.Unsubscribe works. Verified by no crash on source notify post-destroy.'
|
||||
);
|
||||
sourceDirty := nil;
|
||||
end;
|
||||
|
||||
procedure TTestMycCoreLazy.TestFuncLazy_SourceIsInitiallySet_PopBehavesCorrectly;
|
||||
var
|
||||
funcLazy: TLazy<Integer>.ILazy;
|
||||
value: Integer;
|
||||
result: Boolean;
|
||||
sourceDirty: TFlag.IFlag;
|
||||
expectedValue: Integer;
|
||||
procExecuted: Boolean;
|
||||
begin
|
||||
sourceDirty := TFlag.CreateFlag(true);
|
||||
Assert.IsTrue(sourceDirty.State.IsSet, 'SourceDirty should be initially set for this test scenario');
|
||||
expectedValue := 70;
|
||||
procExecuted := False;
|
||||
funcLazy :=
|
||||
TMycFuncLazy<Integer>.Create(
|
||||
sourceDirty.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
procExecuted := True;
|
||||
Result := expectedValue;
|
||||
end
|
||||
);
|
||||
Assert.IsNotNull(funcLazy, 'TMycFuncLazy<Integer> instance should not be nil');
|
||||
Assert.IsTrue(funcLazy.GetChanged.IsSet, 'funcLazy.GetChanged.IsSet should be true after creation (by design)');
|
||||
value := 0;
|
||||
result := funcLazy.Pop(value);
|
||||
Assert.IsTrue(result, 'First Pop should return true');
|
||||
Assert.IsTrue(procExecuted, 'FProc should have been executed on first Pop');
|
||||
Assert.AreEqual(expectedValue, value, 'Value should be the result of FProc');
|
||||
Assert.IsFalse(funcLazy.GetChanged.IsSet, 'Changed state should be false after the first Pop');
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TTestMycCoreLazy);
|
||||
end.
|
||||
@@ -1,453 +0,0 @@
|
||||
unit Myc.Test.Lazy;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals, // For IMycState, TState, IMycDirty
|
||||
Myc.Lazy; // The unit under test
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestMyLazy = class(TObject)
|
||||
private
|
||||
FChangingSignal: TFlag.IFlag; // Used as the 'Changing' state for functional lazy objects
|
||||
|
||||
// Helper to consume the initial pop, which is always expected to succeed
|
||||
// for a TLazy wrapping a functional lazy object due to "Changed.IsSet initially true" design.
|
||||
procedure ConsumeInitialPop(var ALazyRec: TLazy<Integer>; ExpectedInitialValue: Integer; const MsgPrefix: string);
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
[TearDown]
|
||||
procedure TearDown;
|
||||
|
||||
// Tests for TLazy<T>.Create(nil) - Null Object Pattern
|
||||
[Test]
|
||||
procedure TestCreateWithNil_Changed_IsAlwaysTrue;
|
||||
[Test]
|
||||
procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultInteger;
|
||||
[Test]
|
||||
procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultString;
|
||||
|
||||
// Tests for TLazy<T>.Construct (creates a functional lazy object)
|
||||
[Test]
|
||||
procedure TestConstruct_InitialChanged_IsAlwaysTrue;
|
||||
[Test]
|
||||
procedure TestConstruct_FirstPop_SucceedsAndResetsChanged;
|
||||
[Test]
|
||||
procedure TestConstruct_StateInteraction_SignalTriggersChanged;
|
||||
[Test]
|
||||
procedure TestConstruct_StateInteraction_PopResetsChangedAfterSignal;
|
||||
[Test]
|
||||
procedure TestConstruct_StateInteraction_NotifyOnAlreadySetSource_DoesNotRetrigger;
|
||||
[Test]
|
||||
procedure TestConstruct_Destruction_UnsubscribesAndNoCrashOnSourceNotify;
|
||||
|
||||
// Tests for TLazy<T>.Create with a pre-existing (non-nil) IMycLazy
|
||||
[Test]
|
||||
procedure TestCreateWithExistingLazy_DelegatesChangedCorrectly;
|
||||
[Test]
|
||||
procedure TestCreateWithExistingLazy_DelegatesPopCorrectly;
|
||||
|
||||
// Tests for TLazy<T> implicit operators
|
||||
[Test]
|
||||
procedure TestImplicitOperator_FromInterfaceToRecord;
|
||||
[Test]
|
||||
procedure TestImplicitOperator_FromRecordToInterface;
|
||||
|
||||
// Tests for TLazy<T>.Pop specific behaviors (Res undefined)
|
||||
[Test]
|
||||
procedure TestPop_AfterInitialAndNoSignal_ReturnsFalseAndResUndefined;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
// No direct uses of Myc.Core.* units here
|
||||
|
||||
{ TTestMyLazy }
|
||||
|
||||
procedure TTestMyLazy.Setup;
|
||||
begin
|
||||
// Create a common signal source for tests that need it.
|
||||
// TState.CreateDirty is from Myc.Signals.pas (interface part)
|
||||
// Its implementation might rely on Myc.Core.Signals, but that's an indirect usage.
|
||||
FChangingSignal := TFlag.CreateFlag;
|
||||
FChangingSignal.Reset; // Start with a clean (not set) signal for predictable test starts
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TearDown;
|
||||
begin
|
||||
FChangingSignal := nil; // Release the common signal source
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.ConsumeInitialPop(var ALazyRec: TLazy<Integer>; ExpectedInitialValue: Integer; const MsgPrefix: string);
|
||||
var
|
||||
val: Integer;
|
||||
popResult: Boolean;
|
||||
begin
|
||||
Assert.IsTrue(ALazyRec.Changed.IsSet, MsgPrefix + ': Changed.IsSet should be true before initial Pop');
|
||||
popResult := ALazyRec.Pop(val);
|
||||
Assert.IsTrue(popResult, MsgPrefix + ': Initial Pop should return true');
|
||||
Assert.AreEqual(ExpectedInitialValue, val, MsgPrefix + ': Value from initial Pop mismatch');
|
||||
Assert.IsFalse(ALazyRec.Changed.IsSet, MsgPrefix + ': Changed.IsSet should be false after initial Pop');
|
||||
end;
|
||||
|
||||
// == Tests for TLazy<T>.Create(nil) - Null Object Pattern ==
|
||||
|
||||
procedure TTestMyLazy.TestCreateWithNil_Changed_IsAlwaysTrue;
|
||||
var
|
||||
lazyRec: TLazy<Integer>;
|
||||
begin
|
||||
lazyRec := TLazy<Integer>.Create(nil); // This uses the internal FNull (TMycNullLazy)
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'For TLazy created with nil, Changed.IsSet should be true (TMycNullLazy behavior)');
|
||||
// Second check to ensure it's consistently true
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'For TLazy created with nil, Changed.IsSet should remain true');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestCreateWithNil_Pop_ReturnsTrueAndDefaultInteger;
|
||||
var
|
||||
lazyRec: TLazy<Integer>;
|
||||
val: Integer;
|
||||
popResult: Boolean;
|
||||
begin
|
||||
lazyRec := TLazy<Integer>.Create(nil);
|
||||
val := 12345; // Pre-assign to check if Pop overwrites it with Default
|
||||
popResult := lazyRec.Pop(val);
|
||||
Assert.IsTrue(popResult, 'Pop on TLazy created with nil should return true');
|
||||
Assert.AreEqual(Default(Integer), val, 'Pop on TLazy created with nil should set Res to Default(Integer)');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestCreateWithNil_Pop_ReturnsTrueAndDefaultString;
|
||||
var
|
||||
lazyRec: TLazy<string>;
|
||||
val: string;
|
||||
popResult: Boolean;
|
||||
begin
|
||||
lazyRec := TLazy<string>.Create(nil);
|
||||
val := 'test'; // Pre-assign
|
||||
popResult := lazyRec.Pop(val);
|
||||
Assert.IsTrue(popResult, 'Pop on TLazy created with nil (string) should return true');
|
||||
Assert.AreEqual(Default(string), val, 'Pop on TLazy created with nil (string) should set Res to Default(string)');
|
||||
end;
|
||||
|
||||
// == Tests for TLazy<T>.Construct static method ==
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_InitialChanged_IsAlwaysTrue;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
procExecuted: Boolean;
|
||||
begin
|
||||
procExecuted := False;
|
||||
// FChangingSignal is reset in Setup
|
||||
lazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
procExecuted := True;
|
||||
Result := 10;
|
||||
end
|
||||
);
|
||||
Assert.IsNotNull(lazyIntf, 'TLazy.Construct should return a valid interface');
|
||||
|
||||
lazyRec := lazyIntf; // Implicit conversion
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'Constructed lazy object: Initial Changed.IsSet should be true by design');
|
||||
Assert.IsFalse(procExecuted, 'Proc should not have been executed by Construct or by checking Changed state');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_FirstPop_SucceedsAndResetsChanged;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
procExecuted: Boolean;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
procExecuted := False;
|
||||
expectedValue := 20;
|
||||
lazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
procExecuted := True;
|
||||
Result := expectedValue;
|
||||
end
|
||||
);
|
||||
lazyRec := lazyIntf;
|
||||
|
||||
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_FirstPop');
|
||||
Assert.IsTrue(procExecuted, 'Proc should have been executed by the initial Pop');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_StateInteraction_SignalTriggersChanged;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
expectedValue := 30;
|
||||
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end);
|
||||
lazyRec := lazyIntf;
|
||||
|
||||
ConsumeInitialPop(lazyRec, expectedValue, 'TestConstruct_StateInteraction_SignalTriggersChanged (Initial)');
|
||||
Assert.IsFalse(lazyRec.Changed.IsSet, 'After initial Pop, Changed.IsSet should be false');
|
||||
|
||||
FChangingSignal.Notify; // Trigger the source signal
|
||||
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'After source signal Notify, Changed.IsSet should become true');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_StateInteraction_PopResetsChangedAfterSignal;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
val: Integer;
|
||||
popResult: Boolean;
|
||||
procCallCount: Integer;
|
||||
begin
|
||||
procCallCount := 0;
|
||||
lazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
Result := 100 + procCallCount; // Value changes per call
|
||||
end
|
||||
);
|
||||
lazyRec := lazyIntf;
|
||||
|
||||
ConsumeInitialPop(lazyRec, 101, 'TestConstruct_StateInteraction_PopResetsChangedAfterSignal (Initial)'); // procCallCount = 1
|
||||
FChangingSignal.Notify;
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'Changed.IsSet should be true after signal');
|
||||
|
||||
popResult := lazyRec.Pop(val); // procCallCount = 2
|
||||
Assert.IsTrue(popResult, 'Pop after signal should return true');
|
||||
Assert.AreEqual(102, val, 'Value from Pop after signal mismatch');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc call count after second pop mismatch');
|
||||
Assert.IsFalse(lazyRec.Changed.IsSet, 'Changed.IsSet should be false after Pop following signal');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_StateInteraction_NotifyOnAlreadySetSource_DoesNotRetrigger;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
val: Integer;
|
||||
popResult: Boolean;
|
||||
procCallCount: Integer;
|
||||
begin
|
||||
procCallCount := 0;
|
||||
lazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
Result := 200 + procCallCount;
|
||||
end
|
||||
);
|
||||
lazyRec := lazyIntf;
|
||||
|
||||
// 1. Initial Pop
|
||||
ConsumeInitialPop(lazyRec, 201, 'TestConstruct_NotifyOnAlreadySetSource (Initial)'); // procCallCount = 1
|
||||
Assert.IsFalse(FChangingSignal.State.IsSet, 'Source signal FChangingSignal should still be false (was reset in Setup)');
|
||||
|
||||
// 2. Trigger source, make it set, Pop
|
||||
FChangingSignal.Notify; // FChangingSignal.IsSet becomes TRUE
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'Lazy state should be true after FChangingSignal.Notify');
|
||||
popResult := lazyRec.Pop(val); // procCallCount = 2
|
||||
Assert.IsTrue(popResult);
|
||||
Assert.AreEqual(202, val);
|
||||
Assert.IsFalse(lazyRec.Changed.IsSet, 'Lazy state should be false after second Pop');
|
||||
|
||||
// 3. Notify FChangingSignal again. It's already set.
|
||||
// This should NOT re-notify subscribers (like the lazy object's internal trigger)
|
||||
// because TMycDirty only notifies on a false -> true transition.
|
||||
Assert.IsTrue(FChangingSignal.State.IsSet, 'FChangingSignal should still be true before redundant Notify');
|
||||
FChangingSignal.Notify;
|
||||
|
||||
Assert.IsFalse(lazyRec.Changed.IsSet, 'Lazy state should REMAIN false after Notify on an already-set source');
|
||||
|
||||
// 4. Attempt to Pop again
|
||||
popResult := lazyRec.Pop(val); // procCallCount should remain 2
|
||||
Assert.IsFalse(popResult, 'Pop after Notify on an already-set source should return false');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc should not have been called for this Pop');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestConstruct_Destruction_UnsubscribesAndNoCrashOnSourceNotify;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
localChangingSignal: TFlag.IFlag; // Use a local signal for this test to control its lifetime
|
||||
begin
|
||||
localChangingSignal := TFlag.CreateFlag;
|
||||
localChangingSignal.Reset;
|
||||
|
||||
lazyIntf := TLazy<Integer>.Construct(localChangingSignal.State.Signal, function: Integer begin Result := 1; end);
|
||||
Assert.IsNotNull(lazyIntf, 'Constructed lazy interface should not be nil');
|
||||
|
||||
// Simulate usage and release of the lazy object
|
||||
var lazyRec: TLazy<Integer> := lazyIntf; // Wrap for initial pop
|
||||
ConsumeInitialPop(lazyRec, 1, 'TestConstruct_Destruction (Initial)');
|
||||
|
||||
lazyIntf := nil; // Release the ILazy interface. ARC should destroy the TMycFuncLazy object.
|
||||
// This should trigger its destructor, which should unsubscribe from localChangingSignal.
|
||||
|
||||
Assert.WillNotRaise(
|
||||
procedure
|
||||
begin
|
||||
localChangingSignal.Notify; // Notify the source AFTER the lazy object is supposed to be gone.
|
||||
end,
|
||||
nil, // Default: any exception is a failure
|
||||
'Notifying source after lazy object is freed should not crash, indicating unsubscription.'
|
||||
);
|
||||
|
||||
localChangingSignal := nil; // Clean up the local signal itself.
|
||||
end;
|
||||
|
||||
// == Tests for TLazy<T>.Create with a pre-existing (non-nil) ILazy ==
|
||||
|
||||
procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesChangedCorrectly;
|
||||
var
|
||||
originalLazyIntf: TLazy<Integer>.ILazy;
|
||||
wrappedLazyRec: TLazy<Integer>;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
expectedValue := 60;
|
||||
originalLazyIntf := TLazy<Integer>.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end);
|
||||
// originalLazyIntf.Changed.IsSet is true by design
|
||||
|
||||
wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf);
|
||||
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet should reflect original (initially true)');
|
||||
|
||||
ConsumeInitialPop(wrappedLazyRec, expectedValue, 'TestCreateWithExistingLazy_DelegatesChangedCorrectly (Initial)');
|
||||
// Now wrappedLazyRec.Changed.IsSet is false, and so should originalLazyIntf.Changed.IsSet
|
||||
|
||||
Assert.IsFalse(originalLazyIntf.Changed.IsSet, 'Original lazy: Changed.IsSet should also be false after wrapped Pop');
|
||||
|
||||
FChangingSignal.Notify;
|
||||
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet should be true after source signal');
|
||||
Assert.IsTrue(originalLazyIntf.Changed.IsSet, 'Original lazy: Changed.IsSet should also be true after source signal');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesPopCorrectly;
|
||||
var
|
||||
originalLazyIntf: TLazy<Integer>.ILazy;
|
||||
wrappedLazyRec: TLazy<Integer>;
|
||||
val: Integer;
|
||||
popResult: Boolean;
|
||||
procCallCount: Integer;
|
||||
begin
|
||||
procCallCount := 0;
|
||||
originalLazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
Inc(procCallCount);
|
||||
Result := 70 + procCallCount;
|
||||
end
|
||||
);
|
||||
wrappedLazyRec := TLazy<Integer>.Create(originalLazyIntf);
|
||||
|
||||
// First Pop via wrapper (initial pop)
|
||||
ConsumeInitialPop(wrappedLazyRec, 71, 'TestCreateWithExistingLazy_DelegatesPopCorrectly (Initial)'); // procCallCount = 1
|
||||
Assert.AreEqual(1, procCallCount, 'Proc call count after wrapped initial Pop');
|
||||
|
||||
// Second Pop via wrapper (no source change yet)
|
||||
popResult := wrappedLazyRec.Pop(val);
|
||||
Assert.IsFalse(popResult, 'Second Pop via wrapper (no source change) should return false');
|
||||
Assert.AreEqual(1, procCallCount, 'Proc call count should not change');
|
||||
|
||||
// Trigger source, Pop via wrapper
|
||||
FChangingSignal.Notify;
|
||||
Assert.IsTrue(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet true after source signal');
|
||||
popResult := wrappedLazyRec.Pop(val); // procCallCount = 2
|
||||
Assert.IsTrue(popResult, 'Pop via wrapper after source signal should return true');
|
||||
Assert.AreEqual(72, val, 'Value from Pop via wrapper after signal');
|
||||
Assert.AreEqual(2, procCallCount, 'Proc call count after signal and Pop');
|
||||
Assert.IsFalse(wrappedLazyRec.Changed.IsSet, 'Wrapped lazy: Changed.IsSet false after Pop');
|
||||
end;
|
||||
|
||||
// == Tests for TLazy<T> implicit operators ==
|
||||
|
||||
procedure TTestMyLazy.TestImplicitOperator_FromInterfaceToRecord;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
expectedValue := 80;
|
||||
lazyIntf := TLazy<Integer>.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end);
|
||||
Assert.IsNotNull(lazyIntf, 'Interface should be assigned');
|
||||
|
||||
lazyRec := lazyIntf; // Implicit conversion: ILazy<T> to TLazy<T>
|
||||
|
||||
// Verify by using the record
|
||||
Assert.IsTrue(lazyRec.Changed.IsSet, 'Record (from intf): Initial Changed.IsSet should be true');
|
||||
ConsumeInitialPop(lazyRec, expectedValue, 'TestImplicitOperator_FromInterfaceToRecord');
|
||||
end;
|
||||
|
||||
procedure TTestMyLazy.TestImplicitOperator_FromRecordToInterface;
|
||||
var
|
||||
lazyIntfFromConstruct: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
lazyIntfFromRecord: TLazy<Integer>.ILazy;
|
||||
val: Integer;
|
||||
expectedValue: Integer;
|
||||
begin
|
||||
expectedValue := 90;
|
||||
lazyIntfFromConstruct := TLazy<Integer>.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end);
|
||||
lazyRec.Create(lazyIntfFromConstruct); // Explicitly create record
|
||||
|
||||
lazyIntfFromRecord := lazyRec; // Implicit conversion: TLazy<T> to ILazy<T>
|
||||
|
||||
// Verify by using the converted interface
|
||||
Assert.AreSame(lazyIntfFromConstruct, lazyIntfFromRecord, 'Converted interface should be the same as the original wrapped one');
|
||||
Assert.IsTrue(lazyIntfFromRecord.Changed.IsSet, 'Interface (from rec): Initial Changed.IsSet should be true');
|
||||
var popResult := lazyIntfFromRecord.Pop(val); // This also tests if the interface is functional
|
||||
Assert.IsTrue(popResult);
|
||||
Assert.AreEqual(expectedValue, val);
|
||||
Assert.IsFalse(lazyIntfFromRecord.Changed.IsSet);
|
||||
end;
|
||||
|
||||
// == Tests for TLazy<T>.Pop specific behaviors (Res undefined) ==
|
||||
procedure TTestMyLazy.TestPop_AfterInitialAndNoSignal_ReturnsFalseAndResUndefined;
|
||||
var
|
||||
lazyIntf: TLazy<Integer>.ILazy;
|
||||
lazyRec: TLazy<Integer>;
|
||||
val: Integer; // Value will not be checked as Pop returns false
|
||||
popResult: Boolean;
|
||||
procExecuted: Boolean;
|
||||
begin
|
||||
procExecuted := False;
|
||||
lazyIntf :=
|
||||
TLazy<Integer>.Construct(
|
||||
FChangingSignal.State.Signal,
|
||||
function: Integer
|
||||
begin
|
||||
procExecuted := True;
|
||||
Result := 100;
|
||||
end
|
||||
);
|
||||
lazyRec := lazyIntf;
|
||||
|
||||
ConsumeInitialPop(lazyRec, 100, 'TestPop_AfterInitialAndNoSignal (Initial)');
|
||||
Assert.IsTrue(procExecuted, 'Proc should have run for initial pop');
|
||||
procExecuted := False; // Reset for next check
|
||||
|
||||
// FChangingSignal has not been notified again
|
||||
Assert.IsFalse(lazyRec.Changed.IsSet, 'Changed.IsSet must be false before this Pop attempt');
|
||||
popResult := lazyRec.Pop(val);
|
||||
|
||||
Assert.IsFalse(popResult, 'Pop when Changed.IsSet is false should return false');
|
||||
Assert.IsFalse(procExecuted, 'Proc should NOT have run as Pop returned false');
|
||||
// Do NOT check 'val' as its content is undefined when Pop returns false.
|
||||
end;
|
||||
|
||||
initialization
|
||||
TDUnitX.RegisterTestFixture(TTestMyLazy);
|
||||
end.
|
||||
@@ -6,6 +6,7 @@ uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
DUnitX.TestFramework,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataPoint;
|
||||
|
||||
type
|
||||
|
||||
@@ -7,8 +7,9 @@ uses
|
||||
System.Generics.Collections,
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Futures,
|
||||
Myc.Trade.Types,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Trade.DataStream;
|
||||
|
||||
|
||||
@@ -4,7 +4,7 @@ interface
|
||||
|
||||
uses
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Trade.DataStream;
|
||||
|
||||
|
||||
@@ -25,7 +25,7 @@ uses
|
||||
System.IOUtils,
|
||||
Myc.Futures,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Mutable,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Core.FileCache;
|
||||
|
||||
|
||||
+3
-8
@@ -17,18 +17,11 @@ uses
|
||||
TestNotifier in 'TestNotifier.pas',
|
||||
TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',},
|
||||
TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
|
||||
Myc.Core.Tasks in '..\Src\Myc.Core.Tasks.pas',
|
||||
TestTasks in 'TestTasks.pas',
|
||||
Myc.Futures in '..\Src\Myc.Futures.pas',
|
||||
TestCoreFutures in 'TestCoreFutures.pas',
|
||||
Myc.TaskManager in '..\Src\Myc.TaskManager.pas',
|
||||
Myc.Core.Futures in '..\Src\Myc.Core.Futures.pas',
|
||||
Myc.Core.Signals in '..\Src\Myc.Core.Signals.pas',
|
||||
TestFutures in 'TestFutures.pas',
|
||||
Myc.Lazy in '..\Src\Myc.Lazy.pas',
|
||||
Myc.Core.Lazy in '..\Src\Myc.Core.Lazy.pas',
|
||||
Myc.Test.Core.Lazy in '..\Src\Myc.Test.Core.Lazy.pas',
|
||||
Myc.Test.Lazy in '..\Src\Myc.Test.Lazy.pas',
|
||||
Myc.Test.Core.Atomic in '..\Src\Myc.Test.Core.Atomic.pas',
|
||||
Myc.Test.Signals.Latch in '..\Src\Myc.Test.Signals.Latch.pas',
|
||||
Myc.Test.Signals.Dirty in '..\Src\Myc.Test.Signals.Dirty.pas',
|
||||
@@ -37,7 +30,9 @@ uses
|
||||
Myc.Trade.DataStream in '..\Src\Myc.Trade.DataStream.pas',
|
||||
Myc.Test.Trade.DataStream in '..\Src\Myc.Test.Trade.DataStream.pas',
|
||||
Myc.Test.Trade.DataPoint in '..\Src\Myc.Test.Trade.DataPoint.pas',
|
||||
Myc.Trade.DataProvider in '..\Src\Myc.Trade.DataProvider.pas';
|
||||
Myc.Trade.DataProvider in '..\Src\Myc.Trade.DataProvider.pas',
|
||||
Myc.Mutable in '..\Src\Myc.Mutable.pas',
|
||||
Test.Core.Mutable in 'Test.Core.Mutable.pas';
|
||||
|
||||
{ keep comment here to protect the following conditional from being removed by the IDE when adding a unit }
|
||||
{$IFNDEF TESTINSIGHT}
|
||||
|
||||
+2
-7
@@ -117,18 +117,11 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<Form>/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="TestNotifier_ChaosStress.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Core.Tasks.pas"/>
|
||||
<DCCReference Include="TestTasks.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Futures.pas"/>
|
||||
<DCCReference Include="TestCoreFutures.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.TaskManager.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Core.Futures.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Core.Signals.pas"/>
|
||||
<DCCReference Include="TestFutures.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Lazy.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Core.Lazy.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Core.Lazy.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Lazy.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Core.Atomic.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Signals.Latch.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Signals.Dirty.pas"/>
|
||||
@@ -138,6 +131,8 @@ $(PreBuildEvent)]]></PreBuildEvent>
|
||||
<DCCReference Include="..\Src\Myc.Test.Trade.DataStream.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Test.Trade.DataPoint.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Trade.DataProvider.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Mutable.pas"/>
|
||||
<DCCReference Include="Test.Core.Mutable.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -0,0 +1,240 @@
|
||||
unit Test.Core.Mutable;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.SyncObjs,
|
||||
System.Classes,
|
||||
DUnitX.TestFramework,
|
||||
Myc.Signals,
|
||||
Myc.Mutable,
|
||||
Myc.Core.Mutable;
|
||||
|
||||
type
|
||||
[TestFixture]
|
||||
TTestCoreMutable = class
|
||||
private
|
||||
FNotifyCount: Integer;
|
||||
procedure SubscriberCallback;
|
||||
public
|
||||
[Setup]
|
||||
procedure Setup;
|
||||
|
||||
[Test]
|
||||
procedure TestNullMutable;
|
||||
|
||||
[Test]
|
||||
procedure TestFuncMutable_GetValue;
|
||||
|
||||
[Test]
|
||||
procedure TestFuncMutable_Signal;
|
||||
|
||||
[Test]
|
||||
[TestCase('Writeable', '10,20')]
|
||||
procedure TestWriteableMutable(InitialValue, NewValue: Integer);
|
||||
|
||||
[Test]
|
||||
procedure TestWriteableMutable_SignalOnSameValue;
|
||||
|
||||
[Test]
|
||||
[TestCase('Protected', '100,200')]
|
||||
procedure TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
|
||||
|
||||
[Test]
|
||||
procedure TestProtectedMutable_ThreadSafety;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Defaults;
|
||||
|
||||
type
|
||||
// A simple subscriber implementation for testing purposes.
|
||||
TTestSubscriber = class(TInterfacedObject, TSignal.ISubscriber)
|
||||
private
|
||||
FOnNotify: TProc;
|
||||
public
|
||||
constructor Create(const AOnNotify: TProc);
|
||||
function Notify: Boolean;
|
||||
end;
|
||||
|
||||
{ TTestSubscriber }
|
||||
|
||||
constructor TTestSubscriber.Create(const AOnNotify: TProc);
|
||||
begin
|
||||
inherited Create;
|
||||
FOnNotify := AOnNotify;
|
||||
end;
|
||||
|
||||
function TTestSubscriber.Notify: Boolean;
|
||||
begin
|
||||
if Assigned(FOnNotify) then
|
||||
begin
|
||||
FOnNotify;
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ TTestCoreMutable }
|
||||
|
||||
procedure TTestCoreMutable.Setup;
|
||||
begin
|
||||
FNotifyCount := 0;
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.SubscriberCallback;
|
||||
begin
|
||||
TInterlocked.Increment(FNotifyCount);
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestNullMutable;
|
||||
var
|
||||
mutable: TMutable<Integer>;
|
||||
begin
|
||||
mutable := TMutable<Integer>.Create(TMycNullMutable<Integer>.Create(42));
|
||||
Assert.AreEqual(42, mutable.Value);
|
||||
// Explicitly cast record helper to fully qualified interface for comparison
|
||||
Assert.IsTrue(TSignal.ISignal(mutable.Changed) = TSignal.Null, 'Changed signal should be Null');
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestFuncMutable_GetValue;
|
||||
var
|
||||
mutable: TMutable<Integer>;
|
||||
callCount: Integer;
|
||||
func: TFunc<Integer>;
|
||||
begin
|
||||
callCount := 0;
|
||||
func := function: Integer
|
||||
begin
|
||||
Inc(callCount);
|
||||
Result := 42;
|
||||
end;
|
||||
mutable := TMutable<Integer>.Construct(TEvent.CreateEvent.Signal, func);
|
||||
|
||||
Assert.AreEqual(42, mutable.Value, 'First value access failed');
|
||||
Assert.AreEqual(1, callCount, 'Function should have been called once');
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestFuncMutable_Signal;
|
||||
var
|
||||
source: TEvent;
|
||||
mutable: TMutable<Integer>;
|
||||
lazy: TLazy<Integer>;
|
||||
func: TFunc<Integer>;
|
||||
begin
|
||||
source := TEvent.CreateEvent;
|
||||
func := function: Integer
|
||||
begin
|
||||
Result := 123;
|
||||
end;
|
||||
mutable := TMutable<Integer>.Construct(source.Signal, func);
|
||||
|
||||
lazy := TLazy<Integer>.Create(mutable);
|
||||
Assert.IsFalse(lazy.Update, 'Lazy wrapper should not detect a change initially.');
|
||||
|
||||
source.Notify;
|
||||
|
||||
Assert.IsTrue(lazy.Update, 'Lazy wrapper should detect the change after signal.');
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestWriteableMutable(InitialValue, NewValue: Integer);
|
||||
var
|
||||
writeable: TWriteable<Integer>;
|
||||
subscriber: TSignal.ISubscriber;
|
||||
subscription: TSignal.TSubscription;
|
||||
exchangedValue: Integer;
|
||||
begin
|
||||
writeable := TWriteable<Integer>.CreateWriteable(InitialValue);
|
||||
subscriber := TTestSubscriber.Create(SubscriberCallback);
|
||||
subscription := writeable.Changed.Subscribe(subscriber);
|
||||
|
||||
writeable.Value := NewValue;
|
||||
Assert.AreEqual(1, FNotifyCount, 'Changed.Notify should have been called on SetValue');
|
||||
|
||||
subscription.Unsubscribe;
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestWriteableMutable_SignalOnSameValue;
|
||||
var
|
||||
writeable: TWriteable<Integer>;
|
||||
subscriber: TSignal.ISubscriber;
|
||||
subscription: TSignal.TSubscription;
|
||||
begin
|
||||
writeable := TWriteable<Integer>.CreateWriteable(100);
|
||||
subscriber := TTestSubscriber.Create(SubscriberCallback);
|
||||
subscription := writeable.Changed.Subscribe(subscriber);
|
||||
|
||||
subscription.Unsubscribe;
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestProtectedMutable_Delegation(InitialValue, NewValue: Integer);
|
||||
var
|
||||
writeable: TWriteable<Integer>;
|
||||
protectedWriteable: TWriteable<Integer>;
|
||||
subscriber: TSignal.ISubscriber;
|
||||
subscription: TSignal.TSubscription;
|
||||
begin
|
||||
writeable := TWriteable<Integer>.CreateWriteable(InitialValue);
|
||||
protectedWriteable := writeable.Protect;
|
||||
subscriber := TTestSubscriber.Create(SubscriberCallback);
|
||||
subscription := protectedWriteable.Changed.Subscribe(subscriber);
|
||||
|
||||
protectedWriteable.Value := NewValue;
|
||||
Assert.AreEqual(1, FNotifyCount, 'Changed.Notify should have been called on SetValue');
|
||||
|
||||
subscription.Unsubscribe;
|
||||
end;
|
||||
|
||||
procedure TTestCoreMutable.TestProtectedMutable_ThreadSafety;
|
||||
const
|
||||
ThreadCount = 8;
|
||||
Iterations = 2500;
|
||||
var
|
||||
writeable: TWriteable<Integer>;
|
||||
threads: TArray<TThread>;
|
||||
i: Integer;
|
||||
begin
|
||||
// This test verifies that the lock prevents crashes under concurrent access.
|
||||
// It does not test for an atomic sum, as the protected mutable does not
|
||||
// offer a combined Compare-and-Exchange operation.
|
||||
writeable := TWriteable<Integer>.CreateWriteable(0).Protect;
|
||||
|
||||
for i := 0 to ThreadCount - 1 do
|
||||
begin
|
||||
threads := threads + [TThread.CreateAnonymousThread(
|
||||
procedure
|
||||
var
|
||||
j: Integer;
|
||||
begin
|
||||
for j := 1 to Iterations do
|
||||
begin
|
||||
// This is an intentional race condition to test lock stability.
|
||||
// The lock protects the GetValue calls individually,
|
||||
// preventing memory corruption during concurrent access.
|
||||
var curr := writeable.Value;
|
||||
writeable.Value := curr + 1;
|
||||
end;
|
||||
end
|
||||
)];
|
||||
end;
|
||||
|
||||
for var thread in threads do
|
||||
begin
|
||||
thread.FreeOnTerminate := false;
|
||||
thread.Start;
|
||||
end;
|
||||
|
||||
for var thread in threads do
|
||||
begin
|
||||
thread.WaitFor;
|
||||
thread.Free;
|
||||
end;
|
||||
|
||||
// We cannot assert a specific value due to the race condition,
|
||||
// but success means the test completed without exceptions.
|
||||
Assert.IsTrue(True, 'Thread safety test completed without exceptions.');
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -10,7 +10,7 @@ uses
|
||||
Myc.Signals, // For IMycLatch, TMycLatch, IMycState, IMycSubscriber [cite: 62, 68, 53, 45]
|
||||
Myc.Core.Tasks, // For IMycTaskFactory, TMycTaskFactory [cite: 97, 113]
|
||||
Myc.Futures,
|
||||
Myc.Core.Futures; // For IMycFuture, TMycInitStateFuncFuture
|
||||
Myc.Core.Future; // For IMycFuture, TMycInitStateFuncFuture
|
||||
|
||||
type
|
||||
// Helper class to notify a latch when its Notify method is called.
|
||||
|
||||
Reference in New Issue
Block a user