From d0ad547aa3cd2ac72671ca987e656c203fea7032 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Mon, 14 Jul 2025 15:07:36 +0200 Subject: [PATCH] Units renamed & Chart refactored --- AuraTrader/AuraTrader.dproj | 2 +- AuraTrader/FirstStrategy.pas | 2 +- AuraTrader/MainForm.pas | 2 +- Src/Myc.Aura.Module.pas | 2 +- ...c.Core.Futures.pas => Myc.Core.Future.pas} | 2 +- ...Myc.Core.Lazy.pas => Myc.Core.Mutable.pas} | 22 +- Src/Myc.Fmx.Chart.Series.pas | 2 +- Src/Myc.Fmx.Chart.pas | 135 ++---- Src/Myc.Futures.pas | 2 +- Src/{Myc.Lazy.pas => Myc.Mutable.pas} | 7 +- Src/Myc.Test.Core.Lazy.pas | 439 ----------------- Src/Myc.Test.Lazy.pas | 453 ------------------ Src/Myc.Test.Trade.DataPoint.pas | 1 + Src/Myc.Test.Trade.DataStream.pas | 3 +- Src/Myc.Trade.DataProvider.pas | 2 +- Src/Myc.Trade.DataStream.pas | 2 +- Test/MycTests.dpr | 61 ++- Test/MycTests.dproj | 9 +- Test/Test.Core.Mutable.pas | 240 ++++++++++ Test/TestCoreFutures.pas | 2 +- 20 files changed, 340 insertions(+), 1050 deletions(-) rename Src/{Myc.Core.Futures.pas => Myc.Core.Future.pas} (95%) rename Src/{Myc.Core.Lazy.pas => Myc.Core.Mutable.pas} (85%) rename Src/{Myc.Lazy.pas => Myc.Mutable.pas} (94%) delete mode 100644 Src/Myc.Test.Core.Lazy.pas delete mode 100644 Src/Myc.Test.Lazy.pas create mode 100644 Test/Test.Core.Mutable.pas diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj index 5c1bb79..b01b2ad 100644 --- a/AuraTrader/AuraTrader.dproj +++ b/AuraTrader/AuraTrader.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Release + Debug Win64 AuraTrader 3 diff --git a/AuraTrader/FirstStrategy.pas b/AuraTrader/FirstStrategy.pas index a09fc82..15e9677 100644 --- a/AuraTrader/FirstStrategy.pas +++ b/AuraTrader/FirstStrategy.pas @@ -6,7 +6,7 @@ uses System.SysUtils, System.Generics.Collections, Myc.Signals, - Myc.Lazy, + Myc.Mutable, Myc.TaskManager, Myc.Trade.Types, Myc.Trade.DataPoint, diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas index 5409a9b..41340e9 100644 --- a/AuraTrader/MainForm.pas +++ b/AuraTrader/MainForm.pas @@ -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, diff --git a/Src/Myc.Aura.Module.pas b/Src/Myc.Aura.Module.pas index 7382a20..0acef8b 100644 --- a/Src/Myc.Aura.Module.pas +++ b/Src/Myc.Aura.Module.pas @@ -164,7 +164,7 @@ uses System.Generics.Collections, Myc.Signals, Myc.Futures, - Myc.Lazy, + Myc.Mutable, Myc.Trade.DataPoint, Myc.Aura.Parameter; diff --git a/Src/Myc.Core.Futures.pas b/Src/Myc.Core.Future.pas similarity index 95% rename from Src/Myc.Core.Futures.pas rename to Src/Myc.Core.Future.pas index f059085..6b2221a 100644 --- a/Src/Myc.Core.Futures.pas +++ b/Src/Myc.Core.Future.pas @@ -1,4 +1,4 @@ -unit Myc.Core.Futures; +unit Myc.Core.Future; interface diff --git a/Src/Myc.Core.Lazy.pas b/Src/Myc.Core.Mutable.pas similarity index 85% rename from Src/Myc.Core.Lazy.pas rename to Src/Myc.Core.Mutable.pas index 89c57c2..a3ea304 100644 --- a/Src/Myc.Core.Lazy.pas +++ b/Src/Myc.Core.Mutable.pas @@ -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 = class(TInterfacedObject, TMutable.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.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.Exchange(const Value: T): T; -begin - Result := FValue; - FValue := Value; -end; - function TMycWriteableMutable.GetChanged: TSignal; begin Result := FChanged.Signal; @@ -162,16 +154,6 @@ begin FWriteable := AWriteable; end; -function TMycProtectedMutable.Exchange(const Value: T): T; -begin - FLock.BeginWrite; - try - Result := FWriteable.Exchange(Value); - finally - FLock.EndWrite; - end; -end; - function TMycProtectedMutable.GetChanged: TSignal; begin Result := FWriteable.Changed; diff --git a/Src/Myc.Fmx.Chart.Series.pas b/Src/Myc.Fmx.Chart.Series.pas index 3f97bba..616d7f4 100644 --- a/Src/Myc.Fmx.Chart.Series.pas +++ b/Src/Myc.Fmx.Chart.Series.pas @@ -8,7 +8,7 @@ uses System.UITypes, FMX.Graphics, Myc.Signals, - Myc.Lazy, + Myc.Mutable, Myc.Trade.Types, Myc.Trade.DataArray, Myc.Trade.DataPoint, diff --git a/Src/Myc.Fmx.Chart.pas b/Src/Myc.Fmx.Chart.pas index 35c1350..cb02ea7 100644 --- a/Src/Myc.Fmx.Chart.pas +++ b/Src/Myc.Fmx.Chart.pas @@ -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; 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; + FIsDragging := false; // 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; diff --git a/Src/Myc.Futures.pas b/Src/Myc.Futures.pas index ab1f736..c778c2b 100644 --- a/Src/Myc.Futures.pas +++ b/Src/Myc.Futures.pas @@ -86,7 +86,7 @@ type implementation uses - Myc.Core.Futures; + Myc.Core.Future; constructor TFuture.Create(const AFuture: IFuture); begin diff --git a/Src/Myc.Lazy.pas b/Src/Myc.Mutable.pas similarity index 94% rename from Src/Myc.Lazy.pas rename to Src/Myc.Mutable.pas index 6ffcd29..f11fff1 100644 --- a/Src/Myc.Lazy.pas +++ b/Src/Myc.Mutable.pas @@ -1,4 +1,4 @@ -unit Myc.Lazy; +unit Myc.Mutable; interface @@ -48,7 +48,6 @@ type type IWriteable = interface(TMutable.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; overload; static; function Protect: TWriteable; - function AsMutable: TMutable; property Value: T read GetValue write SetValue; @@ -89,7 +87,7 @@ type implementation uses - Myc.Core.Lazy; + Myc.Core.Mutable; { TMutable } @@ -201,7 +199,6 @@ constructor TLazy.Create(const AMutable: TMutable); begin FMutable := AMutable; FChanged := TFlag.CreateFlag; - FChanged.Notify; FChangeState := AMutable.Changed.Subscribe(FChanged); end; diff --git a/Src/Myc.Test.Core.Lazy.pas b/Src/Myc.Test.Core.Lazy.pas deleted file mode 100644 index 7af1743..0000000 --- a/Src/Myc.Test.Core.Lazy.pas +++ /dev/null @@ -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 - Myc.Core.Lazy; // Unit to be tested - -type - [TestFixture] - TTestMycCoreLazy = class(TObject) - private - procedure Helper_ConsumeInitialPop(const ALazy: TLazy.ILazy; InitialExpectedValue: Integer); overload; - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // Tests for TMycNullLazy - [Test] - procedure TestNullLazy_GetChanged_IsAlwaysNullState; - [Test] - procedure TestNullLazy_Pop_ReturnsDefaultIntegerAndTrue; - [Test] - procedure TestNullLazy_Pop_ReturnsDefaultStringAndTrue; - [Test] - procedure TestNullLazy_Pop_ReturnsDefaultInterfaceAndTrue; - - // Tests for TMycFuncLazy 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.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 == -procedure TTestMycCoreLazy.TestNullLazy_GetChanged_IsAlwaysNullState; -var - nullLazy: TLazy.ILazy; - changedState: TState.IState; -begin - nullLazy := TMycNullLazy.Create as TLazy.ILazy; - Assert.IsNotNull(nullLazy, 'TMycNullLazy 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.ILazy; - value: Integer; - result: Boolean; -begin - nullLazy := TMycNullLazy.Create as TLazy.ILazy; - Assert.IsNotNull(nullLazy, 'TMycNullLazy 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.ILazy; - value: string; - result: Boolean; -begin - nullLazy := TMycNullLazy.Create as TLazy.ILazy; - Assert.IsNotNull(nullLazy, 'TMycNullLazy 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.ILazy; - value: TState.IState; - result: Boolean; -begin - nullLazy := TMycNullLazy.Create as TLazy.ILazy; - Assert.IsNotNull(nullLazy, 'TMycNullLazy 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 - Initial State by Design == -procedure TTestMycCoreLazy.TestFuncLazy_GetChanged_IsAlwaysTrueAfterCreation; -var - funcLazy: TLazy.ILazy; - changedState: TState.IState; - sourceDirty: TFlag.IFlag; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - funcLazy := TMycFuncLazy.Create(sourceDirty.State.Signal, function: Integer begin Result := 10; end); - Assert.IsNotNull(funcLazy, 'TMycFuncLazy 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.ILazy; - value: Integer; - result: Boolean; - sourceDirty: TFlag.IFlag; - procExecuted: Boolean; - expectedValue: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - procExecuted := False; - expectedValue := 50; - funcLazy := - TMycFuncLazy.Create( - sourceDirty.State.Signal, - function: Integer - begin - procExecuted := True; - Result := expectedValue; - end - ); - Assert.IsNotNull(funcLazy, 'TMycFuncLazy 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 - Behavior After Initial Pop == - -procedure TTestMycCoreLazy.TestFuncLazy_AfterFirstPop_IfNoSourceChange_GetChangedIsFalse; -var - funcLazy: TLazy.ILazy; - sourceDirty: TFlag.IFlag; - initialProcValue: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - initialProcValue := 33; - funcLazy := TMycFuncLazy.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.ILazy; - value: Integer; - result: Boolean; - sourceDirty: TFlag.IFlag; - initialProcValue: Integer; - procExecutedCount: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - initialProcValue := 44; - procExecutedCount := 0; - funcLazy := - TMycFuncLazy.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.ILazy; - changedState: TState.IState; - sourceDirty: TFlag.IFlag; - initialProcValue: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - initialProcValue := 20; - funcLazy := TMycFuncLazy.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.ILazy; - value: Integer; - result: Boolean; - sourceDirty: TFlag.IFlag; - procCallCount: Integer; - currentExpectedValue: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - procCallCount := 0; - funcLazy := - TMycFuncLazy.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.ILazy; - value: Integer; - resultPop1, resultPop2: Boolean; - sourceDirty: TFlag.IFlag; - procCallCount: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - procCallCount := 0; - funcLazy := - TMycFuncLazy.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.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.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; - sourceDirty: TFlag.IFlag; - tempVal: Integer; -begin - sourceDirty := TFlag.CreateFlag; - sourceDirty.Reset; - funcLazyObj := TMycFuncLazy.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.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.Create( - sourceDirty.State.Signal, - function: Integer - begin - procExecuted := True; - Result := expectedValue; - end - ); - Assert.IsNotNull(funcLazy, 'TMycFuncLazy 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. diff --git a/Src/Myc.Test.Lazy.pas b/Src/Myc.Test.Lazy.pas deleted file mode 100644 index 8dd7f34..0000000 --- a/Src/Myc.Test.Lazy.pas +++ /dev/null @@ -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; ExpectedInitialValue: Integer; const MsgPrefix: string); - public - [Setup] - procedure Setup; - [TearDown] - procedure TearDown; - - // Tests for TLazy.Create(nil) - Null Object Pattern - [Test] - procedure TestCreateWithNil_Changed_IsAlwaysTrue; - [Test] - procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultInteger; - [Test] - procedure TestCreateWithNil_Pop_ReturnsTrueAndDefaultString; - - // Tests for TLazy.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.Create with a pre-existing (non-nil) IMycLazy - [Test] - procedure TestCreateWithExistingLazy_DelegatesChangedCorrectly; - [Test] - procedure TestCreateWithExistingLazy_DelegatesPopCorrectly; - - // Tests for TLazy implicit operators - [Test] - procedure TestImplicitOperator_FromInterfaceToRecord; - [Test] - procedure TestImplicitOperator_FromRecordToInterface; - - // Tests for TLazy.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; 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.Create(nil) - Null Object Pattern == - -procedure TTestMyLazy.TestCreateWithNil_Changed_IsAlwaysTrue; -var - lazyRec: TLazy; -begin - lazyRec := TLazy.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; - val: Integer; - popResult: Boolean; -begin - lazyRec := TLazy.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; - val: string; - popResult: Boolean; -begin - lazyRec := TLazy.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.Construct static method == - -procedure TTestMyLazy.TestConstruct_InitialChanged_IsAlwaysTrue; -var - lazyIntf: TLazy.ILazy; - lazyRec: TLazy; - procExecuted: Boolean; -begin - procExecuted := False; - // FChangingSignal is reset in Setup - lazyIntf := - TLazy.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.ILazy; - lazyRec: TLazy; - procExecuted: Boolean; - expectedValue: Integer; -begin - procExecuted := False; - expectedValue := 20; - lazyIntf := - TLazy.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.ILazy; - lazyRec: TLazy; - expectedValue: Integer; -begin - expectedValue := 30; - lazyIntf := TLazy.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.ILazy; - lazyRec: TLazy; - val: Integer; - popResult: Boolean; - procCallCount: Integer; -begin - procCallCount := 0; - lazyIntf := - TLazy.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.ILazy; - lazyRec: TLazy; - val: Integer; - popResult: Boolean; - procCallCount: Integer; -begin - procCallCount := 0; - lazyIntf := - TLazy.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.ILazy; - localChangingSignal: TFlag.IFlag; // Use a local signal for this test to control its lifetime -begin - localChangingSignal := TFlag.CreateFlag; - localChangingSignal.Reset; - - lazyIntf := TLazy.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 := 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.Create with a pre-existing (non-nil) ILazy == - -procedure TTestMyLazy.TestCreateWithExistingLazy_DelegatesChangedCorrectly; -var - originalLazyIntf: TLazy.ILazy; - wrappedLazyRec: TLazy; - expectedValue: Integer; -begin - expectedValue := 60; - originalLazyIntf := TLazy.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end); - // originalLazyIntf.Changed.IsSet is true by design - - wrappedLazyRec := TLazy.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.ILazy; - wrappedLazyRec: TLazy; - val: Integer; - popResult: Boolean; - procCallCount: Integer; -begin - procCallCount := 0; - originalLazyIntf := - TLazy.Construct( - FChangingSignal.State.Signal, - function: Integer - begin - Inc(procCallCount); - Result := 70 + procCallCount; - end - ); - wrappedLazyRec := TLazy.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 implicit operators == - -procedure TTestMyLazy.TestImplicitOperator_FromInterfaceToRecord; -var - lazyIntf: TLazy.ILazy; - lazyRec: TLazy; - expectedValue: Integer; -begin - expectedValue := 80; - lazyIntf := TLazy.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end); - Assert.IsNotNull(lazyIntf, 'Interface should be assigned'); - - lazyRec := lazyIntf; // Implicit conversion: ILazy to TLazy - - // 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.ILazy; - lazyRec: TLazy; - lazyIntfFromRecord: TLazy.ILazy; - val: Integer; - expectedValue: Integer; -begin - expectedValue := 90; - lazyIntfFromConstruct := TLazy.Construct(FChangingSignal.State.Signal, function: Integer begin Result := expectedValue; end); - lazyRec.Create(lazyIntfFromConstruct); // Explicitly create record - - lazyIntfFromRecord := lazyRec; // Implicit conversion: TLazy to ILazy - - // 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.Pop specific behaviors (Res undefined) == -procedure TTestMyLazy.TestPop_AfterInitialAndNoSignal_ReturnsFalseAndResUndefined; -var - lazyIntf: TLazy.ILazy; - lazyRec: TLazy; - val: Integer; // Value will not be checked as Pop returns false - popResult: Boolean; - procExecuted: Boolean; -begin - procExecuted := False; - lazyIntf := - TLazy.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. diff --git a/Src/Myc.Test.Trade.DataPoint.pas b/Src/Myc.Test.Trade.DataPoint.pas index 25e0b1c..afc68ee 100644 --- a/Src/Myc.Test.Trade.DataPoint.pas +++ b/Src/Myc.Test.Trade.DataPoint.pas @@ -6,6 +6,7 @@ uses System.SysUtils, System.Classes, DUnitX.TestFramework, + Myc.Trade.Types, Myc.Trade.DataPoint; type diff --git a/Src/Myc.Test.Trade.DataStream.pas b/Src/Myc.Test.Trade.DataStream.pas index 737f6ce..9d3b854 100644 --- a/Src/Myc.Test.Trade.DataStream.pas +++ b/Src/Myc.Test.Trade.DataStream.pas @@ -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; diff --git a/Src/Myc.Trade.DataProvider.pas b/Src/Myc.Trade.DataProvider.pas index 34cefd6..d9313c7 100644 --- a/Src/Myc.Trade.DataProvider.pas +++ b/Src/Myc.Trade.DataProvider.pas @@ -4,7 +4,7 @@ interface uses Myc.Signals, - Myc.Lazy, + Myc.Mutable, Myc.Trade.DataPoint, Myc.Trade.DataStream; diff --git a/Src/Myc.Trade.DataStream.pas b/Src/Myc.Trade.DataStream.pas index 5cacabe..8a6126f 100644 --- a/Src/Myc.Trade.DataStream.pas +++ b/Src/Myc.Trade.DataStream.pas @@ -25,7 +25,7 @@ uses System.IOUtils, Myc.Futures, Myc.Signals, - Myc.Lazy, + Myc.Mutable, Myc.Trade.DataPoint, Myc.Core.FileCache; diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index 24ee0b6..b5eca1d 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -5,39 +5,34 @@ program MycTests; {$ENDIF} {$STRONGLINKTYPES ON} uses - FastMM5, - DUnitX.MemoryLeakMonitor.FastMM5, - System.SysUtils, -{$IFDEF TESTINSIGHT} - TestInsight.DUnitX, -{$ELSE} - DUnitX.Loggers.Console, -{$ENDIF } - DUnitX.TestFramework, - 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', - Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas', - Myc.Trade.Node in '..\Src\Myc.Trade.Node.pas', - 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'; + FastMM5, + DUnitX.MemoryLeakMonitor.FastMM5, + System.SysUtils, + {$IFDEF TESTINSIGHT} + TestInsight.DUnitX, + {$ELSE} + DUnitX.Loggers.Console, + {$ENDIF } + DUnitX.TestFramework, + TestNotifier in 'TestNotifier.pas', + TestNotifier_Threading in 'TestNotifier_Threading.pas' {/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',}, + TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas', + TestTasks in 'TestTasks.pas', + Myc.Futures in '..\Src\Myc.Futures.pas', + TestCoreFutures in 'TestCoreFutures.pas', + Myc.TaskManager in '..\Src\Myc.TaskManager.pas', + TestFutures in 'TestFutures.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', + Myc.Trade.DataPoint in '..\Src\Myc.Trade.DataPoint.pas', + Myc.Trade.Node in '..\Src\Myc.Trade.Node.pas', + 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.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} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index 351e4c6..e255d41 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -117,18 +117,11 @@ $(PreBuildEvent)]]>
/TestNotifier_ChaosStress in 'TestNotifier_ChaosStress.pas',
- - - - - - - @@ -138,6 +131,8 @@ $(PreBuildEvent)]]> + + Base diff --git a/Test/Test.Core.Mutable.pas b/Test/Test.Core.Mutable.pas new file mode 100644 index 0000000..459a50c --- /dev/null +++ b/Test/Test.Core.Mutable.pas @@ -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; +begin + mutable := TMutable.Create(TMycNullMutable.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; + callCount: Integer; + func: TFunc; +begin + callCount := 0; + func := function: Integer + begin + Inc(callCount); + Result := 42; + end; + mutable := TMutable.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; + lazy: TLazy; + func: TFunc; +begin + source := TEvent.CreateEvent; + func := function: Integer + begin + Result := 123; + end; + mutable := TMutable.Construct(source.Signal, func); + + lazy := TLazy.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; + subscriber: TSignal.ISubscriber; + subscription: TSignal.TSubscription; + exchangedValue: Integer; +begin + writeable := TWriteable.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; + subscriber: TSignal.ISubscriber; + subscription: TSignal.TSubscription; +begin + writeable := TWriteable.CreateWriteable(100); + subscriber := TTestSubscriber.Create(SubscriberCallback); + subscription := writeable.Changed.Subscribe(subscriber); + + subscription.Unsubscribe; +end; + +procedure TTestCoreMutable.TestProtectedMutable_Delegation(InitialValue, NewValue: Integer); +var + writeable: TWriteable; + protectedWriteable: TWriteable; + subscriber: TSignal.ISubscriber; + subscription: TSignal.TSubscription; +begin + writeable := TWriteable.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; + threads: TArray; + 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.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. diff --git a/Test/TestCoreFutures.pas b/Test/TestCoreFutures.pas index cfef253..660e1d1 100644 --- a/Test/TestCoreFutures.pas +++ b/Test/TestCoreFutures.pas @@ -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.