I have a problem that when I synchronize TIdSync in Delphi 7 (with latest Indy) inside multiple threads at the same time, it executes the same TIdSync instance multiple times.
Here is a simple code. TIdSync is created and called inside my TThread. It should pass and show its handle for this case. But I get a list with same handles in the memo. It works correctly in Delphi 2010+ (probably because it supports anonymous methods).
I am not sure if I understand how TIdSync should work, use it wrong, or there is a bug or some race condition?
type
TMySync = class(TIdSync)
protected
procedure DoSynchronize; override;
public
FID: Integer;
end;
type
TTestThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
procedure TTestThread.Execute;
var
sync: TMySync;
begin
// synchronize some data
sync:=TMySync.Create;
try
sync.FID:=Integer(sync); // this handle
sync.Synchronize;
finally
sync.Free;
end;
end;
procedure TMySync.DoSynchronize;
begin
// show handle and stored handle
Form1.Memo1.Lines.Add(IntToStr(Integer(Self))+' : '+IntToStr(FID));
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
// execute multiple threads
for i:=0 to 10 do
with TTestThread.Create(True) do
Resume;
end;
I get list like this in Delph 7 with same hadnles (so it does not pass right values)
38972948 : 38972948
38970260 : 38970260
38970260 : 38970260
38970260 : 38970260
...
and in Delphi 2010 it is correct
39063248 : 39063248
39063296 : 39063296
39063312 : 39063312
39063328 : 39063328
It is quite unpleasant problem as you see. Any hint appreciated.
Please check again with a small change to lock out the reuse of memory addresses:
type
TTestThread = class( TThread )
private
sync: TMySync;
protected
procedure Execute; override;
public
destructor Destroy; override;
end;
{ TTestThread }
destructor TTestThread.Destroy;
begin
inherited;
sync.Free;
end;
procedure TTestThread.Execute;
begin
inherited;
sync := TMySync.Create;
sync.Id := Integer( sync );
sync.Synchronize;
end;
As you will see, there is no problem at all
Related
I have a class TMyClass, on which I inject interface IFileManager. In this interface there is a method GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream). This method fills AStream depend from ACompanyId. Everything works fine on real code, but when I run unit tests for class TMyClass and mocked IFileManager via framework Spring4D, FastMM reports for memory leak 13-20 bytes: TIndexWrapper x 1. I used last Spring4D version 1.26 from repository(branch main/master)
unit Unit1.pas
interface
DUnitX.TestFramework,
Spring.Mocking;
type
IFileManager = interface (IInvokable)
procedure GetCompanyWorkbook(const ACompanyId: System.Integer; const AStream: TStream);
end;
TMyClass = class
strict private
FFileManager: IFileManager;
public
constructor Create(const AFileManager: IFileManager);
procedure GenerateInvoice(const ACompanyId: System.Integer);
end;
[TestFixture]
TMyClassTests = class
strict private
FMockStream: TStream;
FMyClass: TMyClass;
FFileManager: Mock<IFileManager>;
procedure SetupFileManagerMock();
procedure InitMockStream(const AMockFile: string);
public
[Setup]
procedure Setup();
[TearDown]
procedure TearDown();
[TestCase('Test invoice generation', '2|invoice_2023.xls', '|')]
procedure TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
end;
implementation
uses
System.Classes,
Spring;
constructor TMyClass.Create(const AFileManager: IFileManager);
begin
Guard.CheckNotNull(AFileManager, 'AFileManager');
inherited Create();
Self.FFileManager := AFileManager;
end;
procedure TMyClass.GenerateInvoice(const ACompanyId: System.Integer);
begin
var sTmpFile := Self.GetTempInvoiceFile(ACompanyId);
var fs := TFileStream.Create(sTmpFile, fmCreate);
try
Self.FFileManager.GetComparyWorkbook(ACompanyId, fs);
// Do some operations with stream
finally
fs.Free();
end;
end;
procedure TMyClassTests.Setup();
begin
Self.FMockStream := nil;
Self.FMyClass := TMyClass.Create(Self.FFileManager);
end;
procedure TMyClassTests.TearDown();
begin
Self.FMyClass.Free();
Self.FMockStream.Free();
end;
procedure TMyClassTests.InitMockStream(const AMockFile: string);
begin
Self.FMockStream := TFileStream.Create(AMockFile, fmOpenRead);
end;
procedure TMyClassTests.SetupFileManagerMock();
begin
Self.FFileManager.Setup.Executes(
function(const callInfo: TCallInfo): TValue
begin
callInfo.Args[1].AsType<TStream>.CopyFrom(Self.FMockStream);
end)
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
end;
procedure TMyClassTests.TestGenerateInvoice(const ACompanyId: System.Integer; const AMockFile: string);
begin
Self.InitMockStream(AMockFile);
Self.SetupFileManagerMock();
Assert.WillNotRaiseAny(
procedure
begin
Self.FMyClass.GenerateInvoice(ACompanyId);
end
);
end;
The issue is that you are using this construct which is redundant:
.When(Args.Any)
.GetCompanyWorkbook(Arg.IsAny<System.Integer>, Arg.IsAny<TStream>);
Either pass Args.Any to When or use individual Arg matching on the parameters.
Passing Args.Any causes the mock internally to ignore the individual parameter matching. That causes the temporarily constructed object for the parameter matching to be leaked which is not trivial to be fixed.
Update: I was able to fix the memory leak in develop branch
I have a code (Singleton- Pattern) which works with Delphi RAD 10.1
type
TSharedData = class
private
FPOL: integer;
class var FUniqueInstance: TSharedData;
procedure SetFPol(const Value: integer);
constructor Create;
public
class function GetInstance: TSharedData;
property POL: integer read FPOL write SetFPol;
end;
var
Key: TObject;
implementation
{ TSharedData }
constructor TSharedData.Create;
begin
SetFPol(1);
end;
class function TSharedData.GetInstance: TSharedData;
begin
TMonitor.Enter(Key); // <-- error here
try
if FUniqueInstance = nil then
begin
FUniqueInstance := TSharedData.Create;
end;
finally
TMonitor.Exit(Key);
end;
Result := FUniqueInstance;
end;
procedure TSharedData.SetFPol(const Value: integer);
begin
FPOL := Value;
end;
initialization
Key:= TObject.Create;
finalization
Key.Free;
I need now the same code in Delphi 7. But the compiler said, "TMonitor isn't known".
Where can I find TMonitor or how can I replace it with an alternative function?
I thank you in advance for any information.
You can use TCriticalSection from SyncObjs unit.
The approach changes just a little bit. The critical section should be used as an object. So if you want to protect an area of you object on can do something like:
type
TSafeCounter = class(TObject)
private
FValue: Integer;
FCriticalSection: TCriticalSection;
public
constructor Create;
destructor Destroy; override;
procedure SafeInc;
procedure SafeDec;
function CurValue: Integer;
end;
implementation
{ TSafeCounter }
constructor TSafeCounter.Create;
begin
FCriticalSection := TCriticalSection.Create;
end;
function TSafeCounter.CurValue: Integer;
begin
FCriticalSection.Acquire;
try
Result := FValue;
finally
FCriticalSection.Release;
end;
end;
procedure TSafeCounter.SafeDec;
begin
FCriticalSection.Acquire;
try
Dec(FValue);
finally
FCriticalSection.Release;
end;
end;
destructor TSafeCounter.Destroy;
begin
FCriticalSection.Free;
inherited;
end;
procedure TSafeCounter.SafeInc;
begin
FCriticalSection.Acquire;
try
Inc(FValue);
finally
FCriticalSection.Release;
end;
end;
If you are facing very extreme scenario (performance), you can work another kinds of implementations of critical sections, but them will also increase the complexity of working with it like the read/write critical section.
I have a form with a TMemo that I want to show what is going on in several services started by the application.
What I have running:
idHTTPServer running with idContext responding to requests
a Thread downloading updates from Dropbox
idUDPServer responding to UDP requests
another thread taking care of some database stuff.
the main application thread also needed to add log
Basically, I need to know how to create a standard, unified, thread safe way to channel the log messages to my TMemo and keep the user updated of what is going on.
Since you are already using Indy anyway, you can use Indy's TIdSync (synchronous) or TIdNotify (asynchronous) class to access the TMemo safely. For simple logging purposes, I would use TIdNotify, eg:
type
TLog = class(TIdNotify)
protected
FMsg: string;
procedure DoNotify; override;
public
class procedure LogMsg(const AMsg; string);
end;
procedure TLog.DoNotify;
begin
Form1.Memo1.Lines.Add(FMsg);
end;
class procedure TLog.LogMsg(const AMsg: string);
begin
with TLog.Create do
try
FMsg := AMsg;
Notify;
except
Free;
raise;
end;
end;
Then you can directly call it in any thread like this:
TLog.LogMsg('some text message here');
UPDATE: in Delphi 2009 and later, you can use anonymous procedures with the static versions of TThread.Synchronize() and TThread.Queue(), thus making Indy's TIdSync and TIdNotify classes obsolete, eg:
type
TLog = class
public
class procedure LogMsg(const AMsg; string);
end;
class procedure TLog.LogMsg(const AMsg: string);
begin
TThread.Queue(nil,
procedure
begin
Form1.Memo1.Lines.Add(AMsg);
end
);
end;
Basically, you can build a thread that receive all the message (here, it is a function AddEvent). Messages are queued (and timestamped) and written down to the memo when possible (if you're under heavy load...).
Don't forget to clean the memo if it exceeds a number of line, add exception handling etc...
I use something like this :
TThreadedMsgEvent = class( TThread )
private
FLock : TCriticalSection;
FStr : TQueue<String>;
FMemo : TMemo;
function GetEvent : String;
protected
procedure Execute; override;
public
procedure AddEvent( aMsg : String );
constructor Create( AMemo: TMemo );
destructor Destroy; override;
end;
implementation
{ TThreadedMsgEvent }
procedure TThreadedMsgEvent.AddEvent(aMsg: String);
begin
FLock.Acquire;
FStr.Enqueue( FormatDateTime('DD/MM/YY HH:NN:SS.ZZZ',Now)+ ' : '+ aMsg );
FLock.Release;
end;
constructor TThreadedMsgEvent.Create(aMemo: TMemo);
begin
inherited Create(True);
FreeOnTerminate := False;
FOnMessage := ACallBack;
FStr := TQueue<String>.Create();
FLock := TCriticalSection.Create;
FMemo := aMemo;
Resume;
end;
destructor TThreadedMsgEvent.Destroy; override;
begin
FreeAndNil( FStr );
FreeAndNil( FLock );
end;
procedure TThreadedMsgEvent.Execute;
begin
while not Terminated do
begin
try
if (FStr.Count > 0) then
begin
if Assigned( aMemo ) then
begin
TThread.synchronize( procedure
begin
FMemo.Lines.Add( GetEvent );
end; );
end;
end;
except
end;
TThread.Sleep(1);
end;
end;
function TThreadedMsgEvent.GetEvent: String;
begin
FLock.Acquire;
result := FStr.Dequeue;
FLock.Release;
end;
You can also notify this thread with Windows Messages. It might be easier as you won't need any reference to this thread in your classes.
What is the best way to write a Delphi DUnit test for a TThread descendant when FreeOnTerminate = True? The TThread descendant returns a reference which I need to test for, but I can't figure out how to wait for the thread to finish in the test...
unit uThreadTests;
interface
uses
Classes, TestFramework;
type
TMyThread = class(TThread)
strict private
FId: Integer;
protected
procedure Execute; override;
public
constructor Create(AId: Integer);
property Id: Integer read FId;
end;
TestTMyThread = class(TTestCase)
strict private
FMyId: Integer;
procedure OnThreadTerminate(Sender: TObject);
protected
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestMyThread;
end;
implementation
{ TMyThread }
constructor TMyThread.Create(AId: Integer);
begin
FreeOnTerminate := True;
FId := AId;
inherited Create(False);
end;
procedure TMyThread.Execute;
begin
inherited;
FId := FId + 1;
end;
{ TestTMyThread }
procedure TestTMyThread.TestMyThread;
//var
// LThread: TMyThread;
begin
// LThread := TMyThread.Create(1);
// LThread.OnTerminate := OnThreadTerminate;
// LThread.WaitFor;
// CheckEquals(2, FMyId);
// LThread.Free;
///// The above commented out code is only useful of FreeOnTerminate = False;
with TMyThread.Create(1) do
begin
OnTerminate := OnThreadTerminate;
WaitFor; /// Not sure how else to wait for the thread to finish?
end;
CheckEquals(2, FMyId);
end;
procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
FMyId := (Sender as TMyThread).Id;
end; /// When FreeOnTerminate = True - THIS LINE CAUSES ERROR: Thread Error the handle is invalid
procedure TestTMyThread.SetUp;
begin
inherited;
end;
procedure TestTMyThread.TearDown;
begin
inherited;
end;
initialization
RegisterTests([TestTMyThread.Suite]);
end.
Any ideas would be welcomed.
Delphi 2010.
Subclass the thread to make it more testable. TThread and TObject provide enough hooks that you can add sensing variables to observe that it reaches certain points with the states you want it to have.
I see three aspects to this particular class that you might wish to test:
It computes a value for its Id property based on the value sent to the constructor.
It computes the new Id property in the new thread, not the thread that calls the constructor.
It frees itself when it's finished.
All those things are testable from a subclass, but hard to test otherwise without making changes to the thread's interface. (All the other answers so far require changing the thread's interface, such as by adding more constructor arguments or by changing the way it starts itself. That can make the thread harder, or at least more cumbersome, to use in the real program.)
type
PTestData = ^TTestData;
TTestData = record
Event: TEvent;
OriginalId: Integer;
FinalId: Integer;
end;
TTestableMyThread = class(TMyThread)
private
FData: PTestData;
public
constructor Create(AId: Integer; AData: PTestData);
destructor Destroy; override;
procedure AfterConstruction; override;
end;
constructor TTestableMyThread.Create(AId: Integer; const AData: PTestData);
begin
inherited Create(AId);
FData := AData;
end;
destructor TestableMyThread.Destroy;
begin
inherited;
FData.FinalId := Id;
// Tell the test that the thread has been freed
FData.Event.SetEvent;
end;
procedure TTestableMyThread.AfterConstruction;
begin
FData.OriginalId := Id;
inherited; // Call this last because this is where the thread starts running
end;
Using that subclass, it's possible to write a test that checks the three qualities identified earlier:
procedure TestTMyThread.TestMyThread;
var
Data: TTestData;
WaitResult: TWaitResult;
begin
Data.OriginalId := -1;
Data.FinalId := -1;
Data.Event := TSimpleEvent.Create;
try
TTestableMyThread.Create(1, #Data);
// We don't free the thread, and the event is only set in the destructor,
// so if the event is signaled, it means the thread freed itself: That
// aspect of the test implicitly passes. We don't want to wait forever,
// though, so we fail the test if we have to wait too long. Either the
// Execute method is taking too long to do its computations, or the thread
// isn't freeing itself.
// Adjust the timeout based on expected performance of Execute.
WaitResult := Data.Event.WaitFor(5000);
case WaitResult of
wrSignaled: ; // This is the expected result
wrTimeOut: Fail('Timed out waiting for thread');
wrAbandoned: Fail('Event was abandoned');
wrError: RaiseLastOSError(Data.Event.LastError);
else Fail('Unanticipated error waiting for thread');
end;
CheckNotEquals(2, Data.OriginalId,
'Didn''t wait till Execute to calculate Id');
CheckEquals(2, Data.FinalId,
'Calculated wrong Id value');
finally
Data.Event.Free;
end;
end;
Because you made the thread free itself upon termination then you have asked it to destroy all traces of itself as soon as it is done. Since you cannot exert influence on when it finishes, it is wrong to refer to anything inside the thread after you start it.
The solutions proposed by other, namely asking the thread to signal you when it terminates, are good. I personally would probably elect to do it that way. If you use an event as a signal then you can wait on that event.
However, there is another way to do it.
Create the thread suspended.
Duplicate the thread handle.
Start the thread.
Wait on the duplicated handle.
Because you own the duplicated handle, rather than the thread, you are safe to wait on it. It seems a little more complicated, but I suppose it avoids creating an extra synchronization object where one is not needed. Note that I'm not advocating this approach over the approach of using an event to signal completion.
Anyway, here's a simple demonstration of the idea.
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Classes;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
destructor Destroy; override;
end;
destructor TMyThread.Destroy;
begin
Writeln('I''m dead!');
inherited;
end;
procedure TMyThread.Execute;
begin
end;
var
DuplicatedHandle: THandle;
begin
with TMyThread.Create(True) do // must create suspended
begin
FreeOnTerminate := True;
Win32Check(DuplicateHandle(
GetCurrentProcess,
Handle,
GetCurrentProcess,
#DuplicatedHandle,
0,
False,
DUPLICATE_SAME_ACCESS
));
Start;
end;
Sleep(500);
Writeln('I''m waiting');
if WaitForSingleObject(DuplicatedHandle, INFINITE)=WAIT_OBJECT_0 then
Writeln('Wait succeeded');
CloseHandle(DuplicatedHandle);
Readln;
end.
Create the thread in a suspended state, then set the OnTerminate and finally Resume the thread.
In your test class, define a private boolean field FThreadDone which is initialized with false and set to true by the OnTerminate Eventhandler.
Also, your constructor logic is a bit dirty, as you should not initialize field prior to calling the inherited constructor.
So:
constructor TMyThread.Create(AId: Integer);
begin
inherited Create(true);
FreeOnTerminate := True;
FId := AId;
end;
...
procedure TestTMyThread.TestMyThread;
begin
FThreadDone := False;
with TMyThread.Create(1) do begin // Note: Thread is suspended...
OnTerminate := OnThreadTerminate;
// Resume; // ... and finally started here!
Start;
end;
While not FThreadDone do Application.ProcessMessages;
CheckEquals(2, FMyId);
end;
procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
FMyId := (Sender as TMyThread).Id;
FThreadDone := True;
end;
This should do the job.
EDIT: Corrected stupid corrections, tested, works.
Here is an example using an anonymous thread.
An event (TSimpleEvent) is created
An anonymous thread executes the test thread and
Waits for the event, which signals in the OnTerminate handler of the test thread
The anonymous thread is on hold until executed with a WaitFor
The result was picked up by the OnTerminate handler
The important thing here is that the event is waited for in a thread. No dead-lock situation.
Uses
SyncObjs;
type
TMyThread = class(TThread)
private
FId : Integer;
protected
procedure Execute; override;
public
constructor Create( anInt : Integer);
property Id : Integer read FId;
end;
TestTMyThread = class
strict private
FMyId: Integer;
FMyEvent : TSimpleEvent;
procedure OnThreadTerminate(Sender: TObject);
protected
public
procedure TestMyThread;
end;
{ TMyThread }
constructor TMyThread.Create(anInt : Integer);
begin
inherited Create(True);
FreeOnTerminate := True;
FId := anInt;
end;
procedure TMyThread.Execute;
begin
Inc(FId);
end;
procedure TestTMyThread.TestMyThread;
var
AnonThread : TThread;
begin
FMyEvent := TSimpleEvent.Create(nil,true,false,'');
try
AnonThread :=
TThread.CreateAnonymousThread(
procedure
begin
With TMyThread.Create(1) do
begin
OnTerminate := Self.OnThreadTerminate;
Start;
end;
FMyEvent.WaitFor; // Wait until TMyThread is ready
end
);
AnonThread.FreeOnTerminate := False;
AnonThread.Start;
AnonThread.WaitFor; // Wait here until test is ready
AnonThread.Free;
Assert(FMyId = 2); // Check result
finally
FMyEvent.Free;
end;
end;
procedure TestTMyThread.OnThreadTerminate(Sender: TObject);
begin
FMyId := (Sender as TMyThread).Id;
FMyEvent.SetEvent; // Signal TMyThread ready
end;
Update, since Delphi-2010 does not have an anonymous thread class, here is an alternative which you can implement:
Type
TMyAnonymousThread = class(TThread)
private
FProc : TProc;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended,SelfFree: Boolean; const aProc: TProc);
end;
constructor TMyAnonymousThread.Create(CreateSuspended,SelfFree: Boolean;
const aProc: TProc);
begin
Inherited Create(CreateSuspended);
FreeOnTerminate := SelfFree;
FProc := aProc;
end;
procedure TMyAnonymousThread.Execute;
begin
FProc();
end;
I created a custom component TCustomHTTPReqResp inheriting from THTTPReqResp.
I did also create a custom event for this component. The only problem I'm having is that although the event is published and appears on the IDE, when I assign an event handler and run the application the event handler doesn't get called.
However if assign it on the code on Form.Create i.e.:
CustomHTTPReqResp1.OnBeforeGet := CustomHTTPReqResp1BeforeGet;
it works. Apart from this everything else works just fine.
Have a done something wrong? Thanks in advance.
Here is the code for the custom component:
unit CCustomHTTPReqResp;
interface
uses
SysUtils, Classes, Dialogs, SOAPHTTPTrans;
type
TCustomHTTPReqResp = class(THTTPReqResp)
private
{ Private declarations }
FOnBeforeGet: TNotifyEvent;
procedure DoOnBeforeGet;
protected
{ Protected declarations }
procedure SetOnBeforeGet(const AOnBeforeGet: TNotifyEvent);
public
{ Public declarations }
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Get(Resp: TStream); override;
published
{ Published declarations }
{ Events }
property OnBeforeGet: TNotifyEvent read FOnBeforeGet write SetOnBeforeGet;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('My Components', [TCustomHTTPReqResp]);
end;
{ TCustomHTTPReqResp }
constructor TCustomHTTPReqResp.Create(Owner: TComponent);
begin
inherited Create(Owner);
// Code here.
end;
destructor TCustomHTTPReqResp.Destroy;
begin
// Code here.
inherited;
end;
procedure TCustomHTTPReqResp.SetOnBeforeGet(const AOnBeforeGet: TNotifyEvent);
begin
FOnBeforeGet := AOnBeforeGet;
end;
procedure TCustomHTTPReqResp.DoOnBeforeGet;
begin
if Assigned(FOnBeforeGet) then
begin
FOnBeforeGet(Self);
end
else
begin
MessageDlg('No Before Post Event Handler found!', mtInformation, mbOKCancel, 0);
end;
end;
procedure TCustomHTTPReqResp.Get(Resp: TStream);
begin
// Raise OnBeforeGet.
DoOnBeforeGet;
inherited Get(Resp);
end;
end.
Thanks for the comments everyone, and thanks TLama for the tip.
It turns out I made a mistake on the form. I dropped the custom control on the form from the Tool Palette and also created another one on Form.Create with the same name and I think this caused the problem. Fixed now.