From d2c47843a77bb91e2ac3924fd02cfd56b611fe34 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 17 Jul 2025 23:00:56 +0200 Subject: [PATCH] DataRecord --- AuraTrader/AuraTrader.dpr | 2 +- AuraTrader/AuraTrader.dproj | 2 +- AuraTrader/MainForm.fmx | 8 + AuraTrader/MainForm.pas | 10 +- Src/Myc.DataRecord.pas | 361 +++++++++++++++++++++++++++ Test/Tests.Myc.DirectoryMonitor.pas | 372 ++++++++++++++++++++++++++++ 6 files changed, 752 insertions(+), 3 deletions(-) create mode 100644 Src/Myc.DataRecord.pas create mode 100644 Test/Tests.Myc.DirectoryMonitor.pas 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.