diff --git a/AuraTrader/AuraTrader.dpr b/AuraTrader/AuraTrader.dpr
index 037fea5..008edd7 100644
--- a/AuraTrader/AuraTrader.dpr
+++ b/AuraTrader/AuraTrader.dpr
@@ -13,7 +13,7 @@ uses
Myc.FMX.Chart.Series in '..\Src\Myc.FMX.Chart.Series.pas',
Myc.Trade.Indicators in '..\Src\Myc.Trade.Indicators.pas',
Myc.Trade.Types in '..\Src\Myc.Trade.Types.pas',
- Myc.DirectoryMonitor in '..\Src\Myc.DirectoryMonitor.pas';
+ Myc.DataRecord in '..\Src\Myc.DataRecord.pas';
{$R *.res}
diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj
index c73e8c8..90ff7f2 100644
--- a/AuraTrader/AuraTrader.dproj
+++ b/AuraTrader/AuraTrader.dproj
@@ -141,7 +141,7 @@
-
+
Base
diff --git a/AuraTrader/MainForm.fmx b/AuraTrader/MainForm.fmx
index 9d6f252..2e0137d 100644
--- a/AuraTrader/MainForm.fmx
+++ b/AuraTrader/MainForm.fmx
@@ -199,6 +199,14 @@ object Form1: TForm1
AllowDrag = True
Viewport.Width = 165.000000000000000000
Viewport.Height = 682.000000000000000000
+ object Button1: TButton
+ Position.X = 56.000000000000000000
+ Position.Y = 72.000000000000000000
+ TabOrder = 0
+ Text = 'Button1'
+ TextSettings.Trimming = None
+ OnClick = Button1Click
+ end
end
end
end
diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas
index a1a72bf..a2ee86e 100644
--- a/AuraTrader/MainForm.pas
+++ b/AuraTrader/MainForm.pas
@@ -79,11 +79,13 @@ type
FlowLayout: TFlowLayout;
StrategyButton: TSpeedButton;
Strat2Button: TSpeedButton;
+ Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure TreeViewDblClick(Sender: TObject);
procedure AddWorkspaceActionExecute(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
procedure Strat2ButtonClick(Sender: TObject);
procedure TestActionExecute(Sender: TObject);
procedure StrategyButtonClick(Sender: TObject);
@@ -129,7 +131,8 @@ implementation
uses
TestModule,
- Myc.Trade.Indicators;
+ Myc.Trade.Indicators,
+ Myc.DataRecord;
{$R *.fmx}
@@ -289,6 +292,11 @@ begin
Control.Align := TAlignLayout.Top;
end;
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ Myc.DataRecord.Testfunc;
+end;
+
function TForm1.CreateStrategy2(Timeframe: TTimeframe): IMycProcessor>;
type
TSignal = record
diff --git a/Src/Myc.DataRecord.pas b/Src/Myc.DataRecord.pas
new file mode 100644
index 0000000..536aded
--- /dev/null
+++ b/Src/Myc.DataRecord.pas
@@ -0,0 +1,361 @@
+unit Myc.DataRecord;
+
+interface
+
+uses
+ System.Rtti,
+ System.SysUtils,
+ System.Generics.Collections,
+ System.Generics.Defaults;
+
+type
+ // Provides generic access to a value of type T.
+ IAccess = interface
+ ['{1D422E3A-25C8-459B-A480-2E246942CF56}']
+ function GetValue: T;
+ procedure SetValue(const Value: T);
+ property Value: T read GetValue write SetValue;
+ end;
+
+ // A record that provides field-level access to data, stored in a sorted array.
+ TDataRecord = record
+ public
+ type
+ // Builder for dynamically creating a TDataRecord.
+ TBuilder = record
+ private
+ // Use a list for efficient additions. Will be sorted on creation.
+ FStagedValues: TList>;
+ class operator Initialize(out Dest: TBuilder);
+ class operator Finalize(var Dest: TBuilder);
+ public
+ procedure AddField(const Name: String; const Value: T);
+ function CreateRec: TDataRecord;
+ end;
+
+ private
+ FValues: TArray>;
+ class operator Initialize(out Dest: TDataRecord);
+ class operator Finalize(var Dest: TDataRecord);
+ public
+ function GetAccess(const Name: String): IAccess;
+
+ class function CreateFromRec(const Rec: T): TDataRecord; static;
+ class function CreateBuilder: TDataRecord.TBuilder; static;
+ class function CreateFromJSON(const JSON: string): TDataRecord; static;
+ end;
+
+ TValueAccessor = class(TInterfacedObject, IAccess)
+ private
+ FValues: TArray>;
+ FKey: string;
+ function FindIndex: Integer;
+ public
+ constructor Create(AValues: TArray>; const AKey: string);
+ function GetValue: T;
+ procedure SetValue(const Value: T);
+ end;
+
+ // Comparer for sorting and searching pairs by their string key (Singleton).
+ TPairKeyComparer = class(TComparer>)
+ strict private
+ class var
+ FDefault: IComparer>;
+ class constructor CreateClass;
+ class destructor DestroyClass;
+ public
+ function Compare(const Left, Right: TPair): Integer; override;
+ class property Default: IComparer> read FDefault;
+ end;
+
+procedure Testfunc;
+
+implementation
+
+uses
+ System.TypInfo,
+ System.JSON;
+
+{$region 'TPairKeyComparer'}
+class constructor TPairKeyComparer.CreateClass;
+begin
+ FDefault := TPairKeyComparer.Create;
+end;
+
+class destructor TPairKeyComparer.DestroyClass;
+begin
+ FDefault := nil;
+end;
+
+function TPairKeyComparer.Compare(const Left, Right: TPair): Integer;
+begin
+ Result := TComparer.Default.Compare(Left.Key, Right.Key);
+end;
+{$endregion}
+
+{$region 'TValueAccessor'}
+constructor TValueAccessor.Create(AValues: TArray>; const AKey: string);
+begin
+ inherited Create;
+ FValues := AValues;
+ FKey := AKey;
+end;
+
+function TValueAccessor.FindIndex: Integer;
+var
+ dummyPair: TPair;
+begin
+ // Find the index of the key using binary search with the singleton comparer.
+ dummyPair := TPair.Create(FKey, TValue.Empty);
+ if not TArray.BinarySearch>(FValues, dummyPair, Result, TPairKeyComparer.Default) then
+ Result := -1;
+end;
+
+function TValueAccessor.GetValue: T;
+var
+ idx: Integer;
+begin
+ idx := FindIndex;
+ if idx > -1 then
+ Result := FValues[idx].Value.AsType
+ else
+ raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
+end;
+
+procedure TValueAccessor.SetValue(const Value: T);
+var
+ idx: Integer;
+begin
+ idx := FindIndex;
+ if idx > -1 then
+ // Directly modify the TValue within the TPair in the array.
+ FValues[idx].Value := TValue.From(Value)
+ else
+ raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
+end;
+{$endregion}
+
+{$region 'TDataRecord'}
+function TDataRecord.GetAccess(const Name: String): IAccess;
+var
+ dummyPair: TPair;
+ val: TValue;
+ index: Integer;
+ targetTypeInfo: PTypeInfo;
+begin
+ Result := nil;
+
+ // Use a binary search on the sorted array with the singleton comparer.
+ dummyPair := TPair.Create(Name, TValue.Empty);
+
+ if TArray.BinarySearch>(FValues, dummyPair, index, TPairKeyComparer.Default) then
+ begin
+ val := FValues[index].Value;
+ targetTypeInfo := System.TypeInfo(T);
+ if (val.TypeInfo <> nil) and (val.TypeInfo = targetTypeInfo) then
+ begin
+ Result := TValueAccessor.Create(FValues, Name);
+ end;
+ end;
+end;
+
+class function TDataRecord.CreateFromRec(const Rec: T): TDataRecord;
+var
+ ctx: TRttiContext;
+ recType: TRttiRecordType;
+ field: TRttiField;
+ recValue: TValue;
+ stagedValues: TList>;
+begin
+ stagedValues := TList>.Create;
+ try
+ ctx := TRttiContext.Create;
+ recType := ctx.GetType(TypeInfo(T)) as TRttiRecordType;
+ recValue := TValue.From(Rec);
+
+ for field in recType.GetFields do
+ stagedValues.Add(TPair.Create(field.Name, field.GetValue(recValue.GetReferenceToRawData)));
+
+ // Sort the list and assign it to the result array.
+ stagedValues.Sort(TPairKeyComparer.Default);
+ Result.FValues := stagedValues.ToArray;
+ finally
+ stagedValues.Free;
+ end;
+end;
+
+class function TDataRecord.CreateFromJSON(const JSON: string): TDataRecord;
+var
+ jsonValue: TJSONValue;
+ jsonObject: TJSONObject;
+ pair: TJSONPair;
+ pairValue: TJSONValue;
+ s: string;
+ b: Boolean;
+ i64: Int64;
+ dbl: Double;
+ stagedValues: TList>;
+begin
+ stagedValues := TList>.Create;
+ try
+ jsonValue := TJSONObject.ParseJSONValue(JSON);
+ if not Assigned(jsonValue) or not (jsonValue is TJSONObject) then
+ begin
+ Result.FValues := [];
+ Exit;
+ end;
+ try
+ jsonObject := jsonValue as TJSONObject;
+ for pair in jsonObject do
+ begin
+ pairValue := pair.JsonValue;
+ if pairValue is TJSONNumber then
+ begin
+ if pairValue.TryGetValue(i64) then
+ stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(i64)))
+ else if pairValue.TryGetValue(dbl) then
+ stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(dbl)));
+ end
+ else if pairValue is TJSONString then
+ begin
+ if pairValue.TryGetValue(s) then
+ stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(s)));
+ end
+ else if pairValue is TJSONBool then
+ begin
+ if pairValue.TryGetValue(b) then
+ stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(b)));
+ end
+ else if pairValue is TJSONNull then
+ stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.Empty));
+ end;
+ finally
+ jsonValue.Free;
+ end;
+ // Sort the list and assign it to the result array.
+ stagedValues.Sort(TPairKeyComparer.Default);
+ Result.FValues := stagedValues.ToArray;
+ finally
+ stagedValues.Free;
+ end;
+end;
+
+class function TDataRecord.CreateBuilder: TDataRecord.TBuilder;
+begin
+ Result := Default(TDataRecord.TBuilder);
+end;
+
+class operator TDataRecord.Initialize(out Dest: TDataRecord);
+begin
+ // Initialize the array for a new TDataRecord instance.
+ Dest.FValues := nil;
+end;
+
+class operator TDataRecord.Finalize(var Dest: TDataRecord);
+begin
+ // Finalize the array.
+ Dest.FValues := nil;
+end;
+{$endregion}
+
+{$region 'TDataRecord.TBuilder'}
+procedure TDataRecord.TBuilder.AddField(const Name: String; const Value: T);
+begin
+ FStagedValues.Add(TPair.Create(Name, TValue.From(Value)));
+end;
+
+function TDataRecord.TBuilder.CreateRec: TDataRecord;
+begin
+ // Sort the staged list and create the final record's array from it.
+ FStagedValues.Sort(TPairKeyComparer.Default);
+ Result.FValues := FStagedValues.ToArray;
+ FStagedValues.Clear; // Clear the list after consuming it.
+end;
+
+class operator TDataRecord.TBuilder.Initialize(out Dest: TBuilder);
+begin
+ Dest.FStagedValues := TList>.Create;
+end;
+
+class operator TDataRecord.TBuilder.Finalize(var Dest: TBuilder);
+begin
+ Dest.FStagedValues.Free;
+end;
+{$endregion}
+
+type
+ TTestRec = record
+ A, B, C: Integer;
+ Name: String;
+ Val: Double;
+ end;
+
+procedure Testfunc;
+var
+ testRec: TTestRec;
+ R: TDataRecord;
+ nameAccess: IAccess;
+ bAccess: IAccess;
+const
+ JSON_DATA = '{"IntValue": 123, "StringValue": "Hello JSON", "FloatValue": 99.9, "BoolValue": true, "NullValue": null}';
+begin
+ testRec.A := 1;
+ testRec.B := 5;
+ testRec.C := 10;
+ testRec.Name := 'Hi';
+ testRec.Val := 3.14;
+
+ R := TDataRecord.CreateFromRec(testRec);
+
+ // Test reading a string value
+ nameAccess := R.GetAccess('Name');
+ Assert(Assigned(nameAccess));
+ Assert(nameAccess.Value = 'Hi');
+
+ // Test reading an integer value
+ bAccess := R.GetAccess('B');
+ Assert(Assigned(bAccess));
+ Assert(bAccess.Value = 5);
+
+ // Test writing a value
+ bAccess.Value := 99;
+ Assert(bAccess.Value = 99);
+
+ // Verify that a request for a wrong type returns nil
+ var aAccess := R.GetAccess('A');
+ Assert(not Assigned(aAccess));
+
+ // Test the builder pattern
+ var RecBuilder: TDataRecord.TBuilder := TDataRecord.CreateBuilder;
+ RecBuilder.AddField('ZValue', 222.0); // Changed key to test sorting
+ RecBuilder.AddField('AValue', 'Builder Test');
+ var S := RecBuilder.CreateRec;
+
+ var dblAccess := S.GetAccess('ZValue');
+ Assert(Assigned(dblAccess));
+ Assert(dblAccess.Value = 222.0);
+
+ var strAccess := S.GetAccess('AValue');
+ Assert(Assigned(strAccess));
+ Assert(strAccess.Value = 'Builder Test');
+
+ // Test JSON parsing
+ var jsonRec := TDataRecord.CreateFromJSON(JSON_DATA);
+ var intAccess := jsonRec.GetAccess('IntValue');
+ Assert(Assigned(intAccess));
+ Assert(intAccess.Value = 123);
+
+ strAccess := jsonRec.GetAccess('StringValue');
+ Assert(Assigned(strAccess));
+ Assert(strAccess.Value = 'Hello JSON');
+
+ dblAccess := jsonRec.GetAccess('FloatValue');
+ Assert(Assigned(dblAccess));
+ Assert(dblAccess.Value = 99.9);
+
+ var boolAccess := jsonRec.GetAccess('BoolValue');
+ Assert(Assigned(boolAccess));
+ Assert(boolAccess.Value = true);
+end;
+
+end.
diff --git a/Test/Tests.Myc.DirectoryMonitor.pas b/Test/Tests.Myc.DirectoryMonitor.pas
new file mode 100644
index 0000000..077e5fb
--- /dev/null
+++ b/Test/Tests.Myc.DirectoryMonitor.pas
@@ -0,0 +1,372 @@
+unit Tests.Myc.DirectoryMonitor;
+
+interface
+
+uses
+ DUnitX.TestFramework,
+ System.SysUtils,
+ System.IOUtils,
+ System.Classes,
+ System.Generics.Collections,
+ System.SyncObjs,
+ Myc.DirectoryMonitor,
+ Myc.TaskManager,
+ Myc.Signals;
+
+type
+ [TestFixture]
+ TTestDirectoryMonitor = class(TObject)
+ private
+ // Class fields for paths, shared across all tests in the fixture
+ class var
+ FTestDir: string;
+ FSubDir1: string;
+ FMultiDir1: string;
+ FMultiDir1a: string;
+ FMultiDir2: string;
+ FMultiDir2a: string;
+
+ FMonitorFactory: IDirectoryMonitorFactory;
+
+ procedure CreateEmptyFile(const AFileName: string);
+ class procedure CleanDirectoryContent(const Path: string);
+ class procedure ForceDeleteDirectory(const Path: string);
+ public
+ [SetupFixture]
+ class procedure FixtureSetup;
+ [TearDownFixture]
+ class procedure FixtureTearDown;
+
+ [Setup]
+ procedure Setup;
+ [TearDown]
+ procedure TearDown;
+
+ [Test]
+ procedure TestInitialization_Finds_Correct_Initial_Files;
+ [Test]
+ [IgnoreMemoryLeaks]
+ procedure TestFile_Triggers_Changed_Notification;
+ [Test]
+ procedure TestMultiDirectory_MultiExtension_And_Subdirs;
+ [Test]
+ [IgnoreMemoryLeaks]
+ procedure TestFile_Rename_And_Move_Triggers_Correct_Notifications;
+ [Test]
+ procedure TestRapid_CreateDelete_IsHandledCorrectly;
+ [Test]
+ [Timeout(30000)] // 30 second timeout for this potentially slow test
+ procedure TestStress_BufferOverflowRecovery;
+ end;
+
+implementation
+
+{ TTestDirectoryMonitor }
+
+class procedure TTestDirectoryMonitor.FixtureSetup;
+begin
+ // This runs once before any tests in this class.
+ // Initialize all paths
+ // FTestDir := TPath.Combine(TPath.GetTempPath, 'DirectoryMonitorTest');
+ FTestDir := TPath.Combine('\\COFFEE\TickData\Test', 'DirectoryMonitorTest');
+
+ FSubDir1 := TPath.Combine(FTestDir, 'Sub1');
+ FMultiDir1 := TPath.Combine(FTestDir, 'Dir1');
+ FMultiDir1a := TPath.Combine(FMultiDir1, 'Sub1A');
+ FMultiDir2 := TPath.Combine(FTestDir, 'Dir2');
+ FMultiDir2a := TPath.Combine(FMultiDir2, 'Sub2A');
+
+ // Ensure a clean state from previous runs
+ ForceDeleteDirectory(FTestDir);
+ Sleep(200); // Give network file system time to process deletion
+
+ // Create the entire directory structure needed for all tests
+ TDirectory.CreateDirectory(FTestDir);
+ TDirectory.CreateDirectory(FSubDir1);
+ TDirectory.CreateDirectory(FMultiDir1);
+ TDirectory.CreateDirectory(FMultiDir1a);
+ TDirectory.CreateDirectory(FMultiDir2);
+ TDirectory.CreateDirectory(FMultiDir2a);
+end;
+
+class procedure TTestDirectoryMonitor.FixtureTearDown;
+begin
+end;
+
+procedure TTestDirectoryMonitor.Setup;
+begin
+ // This runs before each individual test.
+ // Clean files from previous test, but leave directory structure intact.
+ CleanDirectoryContent(FTestDir);
+
+ // Get a fresh factory instance for each test.
+ FMonitorFactory := CreateDirectoryMonitorFactory;
+end;
+
+procedure TTestDirectoryMonitor.TearDown;
+begin
+ // This runs after each individual test.
+ // Release the factory and the monitor it created.
+ FMonitorFactory := nil;
+end;
+
+class procedure TTestDirectoryMonitor.CleanDirectoryContent(const Path: string);
+begin
+ // Helper to delete all files and recursively clean subdirectories,
+ // leaving the directory structure itself in place.
+ if not TDirectory.Exists(Path) then
+ exit;
+
+ for var dir in TDirectory.GetDirectories(Path) do
+ CleanDirectoryContent(dir);
+
+ for var f in TDirectory.GetFiles(Path) do
+ TFile.Delete(f);
+end;
+
+class procedure TTestDirectoryMonitor.ForceDeleteDirectory(const Path: string);
+begin
+ if not TDirectory.Exists(Path) then
+ exit;
+
+ CleanDirectoryContent(Path);
+
+ // Finally, delete the now-empty directory
+ TDirectory.Delete(Path, false);
+end;
+
+procedure TTestDirectoryMonitor.CreateEmptyFile(const AFileName: string);
+begin
+ TFile.WriteAllText(AFileName, '', TEncoding.UTF8);
+end;
+
+procedure TTestDirectoryMonitor.TestInitialization_Finds_Correct_Initial_Files;
+var
+ monitor: IDirectoryMonitor;
+ file1_txt: string;
+ file2_log: string;
+ file3_sub_txt: string;
+begin
+ // Arrange: The directories exist; we only need to create the files.
+ file1_txt := TPath.Combine(FTestDir, 'file1.txt');
+ file2_log := TPath.Combine(FTestDir, 'file2.log');
+ file3_sub_txt := TPath.Combine(FSubDir1, 'file3.txt');
+
+ CreateEmptyFile(file1_txt);
+ CreateEmptyFile(file2_log);
+ CreateEmptyFile(file3_sub_txt);
+
+ FMonitorFactory.AddDirectory(FTestDir, TSubDirectoryHandling.Recursive);
+ FMonitorFactory.AddExtension('.txt');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.FileNameChange]);
+
+ // Act
+ monitor := FMonitorFactory.CreateMonitor;
+
+ // Assert
+ Assert.AreEqual(2, monitor.FileCount, 'Should find exactly 2 .txt files');
+ Assert.IsNotNull(monitor.Files[file1_txt], 'file1.txt should be found.');
+ Assert.IsNotNull(monitor.Files[file3_sub_txt], 'file3.txt should be found.');
+ Assert.IsNull(monitor.Files[file2_log], 'file2.log should be ignored.');
+end;
+
+procedure TTestDirectoryMonitor.TestFile_Triggers_Changed_Notification;
+var
+ monitor: IDirectoryMonitor;
+ fileToChange: string;
+ initialFileInfo: IFileInfo;
+ notificationReceived: System.SyncObjs.TEvent;
+ notifiedState: TFileState;
+ receivedFileInfo: IFileInfo;
+ waitResult: TWaitResult;
+begin
+ // Arrange
+ fileToChange := TPath.Combine(FTestDir, 'change_me.txt');
+ CreateEmptyFile(fileToChange);
+
+ FMonitorFactory.AddDirectory(FTestDir, TSubDirectoryHandling.Ignore);
+ FMonitorFactory.AddExtension('.txt');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.LastWriteChange, TFileChangeKind.SizeChange]);
+
+ monitor := FMonitorFactory.CreateMonitor;
+ initialFileInfo := monitor.Files[fileToChange];
+ Assert.IsNotNull(initialFileInfo, 'File to change should be present after initialization.');
+
+ notificationReceived := System.SyncObjs.TEvent.Create(nil, true, false, '');
+ try
+ notifiedState := TFileState.Unchanged;
+ receivedFileInfo := nil;
+
+ initialFileInfo.AddChangeNotification(
+ function(AFileInfo: IFileInfo; ANewState: TFileState): Boolean
+ begin
+ receivedFileInfo := AFileInfo;
+ notifiedState := ANewState;
+ notificationReceived.SetEvent;
+ Result := false;
+ end
+ );
+
+ // Act
+ TFile.AppendAllText(fileToChange, 'some new content');
+
+ // Assert
+ waitResult := notificationReceived.WaitFor(2000);
+
+ Assert.AreEqual(TWaitResult.wrSignaled, waitResult, 'Notification event was not signaled in time.');
+ Assert.AreEqual(TFileState.Changed, notifiedState, 'Notification state should be "Changed".');
+ finally
+ notificationReceived.Free;
+ end;
+end;
+
+procedure TTestDirectoryMonitor.TestMultiDirectory_MultiExtension_And_Subdirs;
+var
+ monitor: IDirectoryMonitor;
+ f1_log, f3_tmp, f5_log: string;
+ f2_txt, f6_ignored_tmp: string;
+begin
+ // Arrange: Directories are pre-created. We just create files.
+ f1_log := TPath.Combine(FMultiDir1, 'file1.log');
+ f2_txt := TPath.Combine(FMultiDir1, 'file2.txt');
+ f3_tmp := TPath.Combine(FMultiDir1a, 'file3.tmp');
+ f5_log := TPath.Combine(FMultiDir2, 'file5.log');
+ f6_ignored_tmp := TPath.Combine(FMultiDir2a, 'file6.tmp');
+
+ CreateEmptyFile(f1_log);
+ CreateEmptyFile(f2_txt);
+ CreateEmptyFile(f3_tmp);
+ CreateEmptyFile(f5_log);
+ CreateEmptyFile(f6_ignored_tmp);
+
+ FMonitorFactory.AddDirectory(FMultiDir1, TSubDirectoryHandling.Recursive);
+ FMonitorFactory.AddDirectory(FMultiDir2, TSubDirectoryHandling.Ignore);
+ FMonitorFactory.AddExtension('.log');
+ FMonitorFactory.AddExtension('.tmp');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.FileNameChange]);
+
+ // Act
+ monitor := FMonitorFactory.CreateMonitor;
+
+ // Assert
+ Assert.AreEqual(3, monitor.FileCount, 'Should find 3 files (.log or .tmp) respecting recursion rules.');
+ Assert.IsNotNull(monitor.Files[f1_log], 'f1.log should be found in Dir1.');
+ Assert.IsNotNull(monitor.Files[f3_tmp], 'f3.tmp should be found in recursive Dir1/Sub1A.');
+ Assert.IsNotNull(monitor.Files[f5_log], 'f5.log should be found in Dir2.');
+ Assert.IsNull(monitor.Files[f2_txt], 'f2.txt should be ignored due to extension mismatch.');
+ Assert.IsNull(monitor.Files[f6_ignored_tmp], 'f6.tmp should be ignored because Dir2 is not monitored recursively.');
+end;
+
+procedure TTestDirectoryMonitor.TestFile_Rename_And_Move_Triggers_Correct_Notifications;
+var
+ monitor: IDirectoryMonitor;
+ originalFile, renamedFile, movedFile: string;
+ countdown: TCountdownEvent;
+ initialInfo: IFileInfo;
+ waitResult: TWaitResult;
+begin
+ // Arrange
+ originalFile := TPath.Combine(FTestDir, 'original.txt');
+ renamedFile := TPath.Combine(FTestDir, 'renamed.txt');
+ movedFile := TPath.Combine(FSubDir1, 'moved.txt');
+ CreateEmptyFile(originalFile);
+
+ FMonitorFactory.AddDirectory(FTestDir, TSubDirectoryHandling.Recursive);
+ FMonitorFactory.AddExtension('.txt');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.FileNameChange]);
+ monitor := FMonitorFactory.CreateMonitor;
+
+ countdown := TCountdownEvent.Create(1);
+ try
+ initialInfo := monitor.Files[originalFile];
+ Assert.IsNotNull(initialInfo, 'Initial file must exist in monitor.');
+ initialInfo.AddChangeNotification(
+ function(AFileInfo: IFileInfo; ANewState: TFileState): Boolean
+ begin
+ if ANewState = TFileState.Deleted then
+ countdown.Signal;
+ Result := true;
+ end
+ );
+
+ // Act & Assert 1: Rename
+ TFile.Move(originalFile, renamedFile);
+ waitResult := countdown.WaitFor(2000);
+ Assert.AreEqual(TWaitResult.wrSignaled, waitResult, 'Delete notification for original file did not arrive in time.');
+ Sleep(100);
+ Assert.IsNotNull(monitor.Files[renamedFile], 'Renamed file should be present in monitor.');
+
+ // Arrange 2
+ countdown.Reset(1);
+ var renamedInfo := monitor.Files[renamedFile];
+ Assert.IsNotNull(renamedInfo);
+ renamedInfo.AddChangeNotification(
+ function(AFileInfo: IFileInfo; ANewState: TFileState): Boolean
+ begin
+ if ANewState = TFileState.Deleted then
+ countdown.Signal;
+ Result := true;
+ end
+ );
+
+ // Act & Assert 2: Move
+ TFile.Move(renamedFile, movedFile);
+ waitResult := countdown.WaitFor(2000);
+ Assert.AreEqual(TWaitResult.wrSignaled, waitResult, 'Delete notification for renamed file did not arrive in time.');
+ Sleep(100);
+ Assert.IsNotNull(monitor.Files[movedFile], 'Moved file should be present in monitor.');
+ Assert.AreEqual(1, monitor.FileCount, 'Monitor should only contain one file at the end.');
+ finally
+ countdown.Free;
+ end;
+end;
+
+procedure TTestDirectoryMonitor.TestRapid_CreateDelete_IsHandledCorrectly;
+var
+ monitor: IDirectoryMonitor;
+ rapidFile: string;
+begin
+ // Arrange
+ rapidFile := TPath.Combine(FTestDir, 'rapid.txt');
+ FMonitorFactory.AddDirectory(FTestDir, TSubDirectoryHandling.Ignore);
+ FMonitorFactory.AddExtension('.txt');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.FileNameChange]);
+ monitor := FMonitorFactory.CreateMonitor;
+
+ // Act
+ CreateEmptyFile(rapidFile);
+ TFile.Delete(rapidFile);
+ Sleep(500);
+
+ // Assert
+ Assert.AreEqual(0, monitor.FileCount, 'Monitor should be empty after rapid create/delete.');
+ Assert.IsNull(monitor.Files[rapidFile], 'The rapidly created/deleted file should not exist in the monitor.');
+end;
+
+procedure TTestDirectoryMonitor.TestStress_BufferOverflowRecovery;
+const
+ NumFiles = 4000;
+var
+ monitor: IDirectoryMonitor;
+ i: Integer;
+ filePath: string;
+begin
+ // Arrange
+ FMonitorFactory.AddDirectory(FTestDir, TSubDirectoryHandling.Ignore);
+ FMonitorFactory.AddExtension('.tmp');
+ FMonitorFactory.SetChangeKinds([TFileChangeKind.FileNameChange]);
+ monitor := FMonitorFactory.CreateMonitor;
+
+ // Act
+ for i := 1 to NumFiles do
+ begin
+ filePath := TPath.Combine(FTestDir, IntToStr(i) + '.tmp');
+ CreateEmptyFile(filePath);
+ end;
+ Sleep(5000);
+
+ // Assert
+ Assert.AreEqual(NumFiles, monitor.FileCount, 'Monitor should recover from overflow and report the correct file count.');
+end;
+
+end.