delphi variable value is changing at thread in a loop - delphi

my code is running a for loop to process some data like here
procedure printValue(Value: Integer);
begin
TThread.Synchronize(TThread.Current, procedure
begin
form1.memo1.lines.add( Value.ToString );
end);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
myThread : TThread;
Proc1: TMyProc;
begin
for I := 0 to 10 do
begin
myThread := TThread.CreateAnonymousThread(
procedure
begin
printValue( i );
end);
myThread.Start;
end;
end;
this code out put is like this:
3
5
6
8
9
11
10
4
11
4
7
this is not good so i add a small delay like sleep(1) after thread start.this will fix output problem but not a good idea because in a large loop block the ui thread so try to use this document as help so my code changed like this:
function CaptureValue(Value: Integer): TMyProc;
begin
Result := procedure begin Writeln(Value); end;
end;
procedure printValue(Value: Integer);
begin
TThread.Synchronize(TThread.Current, procedure
begin
form1.memo1.lines.add( Value.ToString );
end);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
myThread : TThread;
Proc1: TMyProc;
begin
for I := 0 to 10 do
begin
myThread := TThread.CreateAnonymousThread(
procedure
begin
Proc1:= CaptureValue(i);
printValue( Proc1 );
end);
myThread.Start;
end;
end;
but i got [dcc32 Error] Unit11.pas(57): E2010 Incompatible types: 'Integer' and 'procedure, untyped pointer or untyped parameter' error.
what is wrong with my code?

Anonymous procedures capture variables, not values. This is documented behavior. So in both of your examples, your threads are sharing a single I variable with no synchronization over the access of that variable.
You had the right idea to pass I to a procedure and then capture it from the argument list before using it. However, you went about it the wrong way.
The reason your second example actually fails to compile is because you are misusing CaptureValue(). It returns a TMyProc, which is clearly a reference to procedure (which BTW, the RTL already has a TProc for that same purpose). You are passing an anonymous procedure as-is to printValue(), which takes an Integer instead. That is what the compiler error is complaining about.
The way you are using the return value, CaptureValue() would have to instead return an anonymous function that itself returns an Integer (ie, have CaptureValue() return a reference to function: Integer, aka TFunc<Integer>), then call that function and pass that return value to PrintValue().
You are still capturing I itself before passing it to CaptureValue(), though, so you still have threads sharing I. You would need to call CaptureValue() from inside the loop directly before calling CreateAnonymousThread(). But then, your threads would be capturing and sharing the Proc1 variable instead, so you would be right back to the original problem.
With that said, try something more like this instead:
procedure PrintValue(Value: Integer);
begin
TThread.Synchronize(nil,
procedure
begin
Form1.Memo1.Lines.Add( Value.ToString );
end
);
end;
function CaptureAndPrintValue(Value: Integer): TProc;
begin
Result := procedure
begin
printValue( Value );
end
);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
for I := 0 to 10 do
begin
TThread.CreateAnonymousThread(
CaptureAndPrintValue(I)
).Start;
end;
end;
Or, you can let the RTL handle the threading for you:
uses
..., System.Threading;
procedure PrintValue(Value: Integer);
begin
// can't use TThread.Synchronize() with TParallel, as it
// doesn't service the main message queue while looping...
TThread.Queue(nil,
procedure
begin
Form1.Memo1.Lines.Add( Value.ToString );
end
);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TParallel.For(0, 10,
procedure(I: Integer)
begin
PrintValue(I);
end
);
end;

Related

IdThreadComponent (Indy 9) in Delphi 2007 Error

I'm using IdTCPClient and IdThreadComponent to get some information for a barcode reader. This code, with some changes is working in Delphi 11 and Indy 10 but not in Delphi 2007 and Indy 9:
procedure TPkgSendF1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
var
s: String;
begin
s := IdTCPClient1.ReadLn('&', 20000, 1500);
TThread.Queue(nil, procedure // <== Expected # but received PROCEDURE
begin
ProcessRead(s);
end);
end;
// [DCC Error] PkgSendF1.pas(239): E2029 Expression expected but 'PROCEDURE' found
procedure TPkgSendF1.ProcessRead(AValue: string);
begin
Memo1.Text := AValue;
end;
If I don't use the TThread.Queue I miss some readings.
I'll appreciate any help.
Francisco Alvarado
Anonymous methods did not exist yet in Delphi 2007, they were introduced in Delphi 2010. As such, TThread.Queue() in D2007 only had 1 version that accepted a TThreadMethod:
type
TThreadMethod = procedure of object;
Which means you need to wrap the call to ProcessRead() inside a helper object that has a procedure with no parameters, eg:
type
TQueueHelper = class
public
Caller: TPkgSendF1;
Value: String;
procedure DoProcessing;
end;
procedure TQueueHelper.DoProcessing;
begin
try
Caller.ProcessRead(Value);
finally
Free;
end;
end;
procedure TPkgSendF1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
var
s: string;
begin
s := IdTCPClient1.ReadLn('&', 20000, 1500);
with TQueueHelper.Create do
begin
Caller := Self;
Value := s;
TThread.Queue(nil, DoProcessing);
end;
end;
FYI, Indy (both 9 and 10) has an asynchronous TIdNotify class in the IdSync unit, which you can use instead of using TThread.Queue() directly, eg:
uses
IdSync;
type
TMyNotify = class(TIdNotify)
public
Caller: TPkgSendF1;
Value: String;
procedure DoNotify; override;
end;
procedure TMyNotify.DoNotify;
begin
Caller.ProcessRead(Value);
end;
procedure TPkgSendF1.IdThreadComponent1Run(Sender: TIdCustomThreadComponent);
var
s: string;
begin
s := IdTCPClient1.ReadLn('&', 20000, 1500);
with TMyNotify.Create do
begin
Caller := Self;
Value := s;
Notify;
end;
end;

Delphi cannot execute procedure in Task with object references

I have a simple class that has the following interface implementation.
Note: TPolyBase is an abstract class and TPolyResult is an array of double; it's not important to see their code, it's not relevant here.
//INTERFACE
type
TPolynomialList = class
strict private
FPolynomialList: TObjectList<TPolyBase>;
FResult: TList<TPolyResult>;
FCanGet: boolean;
function GetResult: TList<TPolyResult>;
procedure DoSolve;
public
constructor Create(PolynomialList: TObjectList<TPolyBase>);
destructor Destroy; override;
procedure SolvePolynomials(CompletionHandler: TProc);
property Solutions: TList<TPolyResult> read GetResult;
end;
//IMPLEMENTATION
constructor TPolynomialList.Create(PolynomialList: TObjectList<TPolyBase>);
begin
FPolynomialList := PolynomialList;
FResult := TList<TPolyResult>.Create;
FCanGet := false;
end;
destructor TPolynomialList.Destroy;
begin
FResult.Free;
inherited;
end;
procedure TPolynomialList.DoSolve;
var
i: integer;
begin
for i := 0 to FPolynomialList.Count - 1 do
FResult.Add(FPolynomialList[i].GetSolutions);
FCanGet := true;
end;
function TPolynomialList.GetResult: TList<TPolyResult>;
begin
if FCanGet = false then
raise TEquationError.Create('You must solve the equation first!');
Result := FResult;
end;
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
TTask.Run(procedure
var
ex: TObject;
begin
try
DoSolve;
TThread.Synchronize(nil, procedure
begin
CompletionHandler;
end);
except
on E: Exception do
begin
ex := AcquireExceptionObject;
TThread.Synchronize(nil, procedure
begin
Writeln( (ex as Exception).Message );
end);
end;
end;
end);
end;
This class takes a list of objects as input and it has an internal important field called FResult that gives the results to the user. It can be accessed from the getter only if the method SolvePolynomials has finished his work.
The problem is in the SolvePolynomials. The code I have shown uses a task because the size of the object list may be very big and I don't want to freeze the UI. Why do I always get an access violation in the task code?
Note that the following code works fine but this is not what I want because if I input 15000 the program freezes for a few seconds.
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
DoSolve;
CompletionHandler;
end;
Could the FPolynomialList variable be a the problem? If you look at my class the only thing "taken from outside" is the TObjectList<TPolyBase> because in the constructor I simply assing the reference (I'd like to avoid the copy ok 15k items). All the other variables are not shared with anything.
I have seen in many books I have read like "Delphi High Performance" that is good to have a task that calls an inner "slow" method but in this case there could be those reference that are messing up something. Any idea?
This is the code that I am using as test:
var
a: TObjectList<TPolyBase>;
i, j: integer;
f: TPolynomialList;
s: string;
function GetRandom: integer;
begin
Result := (Random(10) + 1);
end;
begin
a := TObjectList<TPolyBase>.Create(true);
try
for i := 0 to 15000 do
begin
a.Add({*Descendant of TPolyBase*})
end;
f := TPolynomialList.Create(a);
try
f.SolvePolynomials(procedure
var
i, j: integer;
begin
for i := 0 to f.Solutions.Count - 1 do
begin
for j := Low(f.Solutions[i]) to High(f.Solutions[i]) do
Writeln({output the results...})
end;
end);
finally
f.Free;
end;
finally
a.Free;
end;
end.
Your SolvePolynomials method delegates solving to another thread and returns before that thread is finished with its task. While that task thread is running it is necessary that all data it operates on is still alive. But, in your code you are releasing necessary object instances right after SolvePolynomials exits - while your task is still running, hence the error.
You have to move releasing of those objects into completion handler.
Basically, your code simplified looks like:
type
TPolynomialList = class
public
destructor Destroy; override;
procedure DoSolve;
procedure SolvePolynomials(CompletionHandler: TProc);
end;
destructor TPolynomialList.Destroy;
begin
Writeln('Destroyed');
inherited;
end;
procedure TPolynomialList.DoSolve;
begin
Writeln('Solving');
end;
procedure TPolynomialList.SolvePolynomials(CompletionHandler: TProc);
begin
TTask.Run(
procedure
begin
try
DoSolve;
TThread.Synchronize(nil,
procedure
begin
CompletionHandler;
end);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end);
end;
procedure Test;
var
f: TPolynomialList;
begin
f := TPolynomialList.Create;
try
f.SolvePolynomials(
procedure
begin
Writeln('Solved');
end);
finally
f.Free;
end;
end;
If you run it output will be:
Destroyed
Solving
Solved
However, if you move releasing of your variables into completion handler order of execution will be correct.
procedure Test;
var
f: TPolynomialList;
begin
f := TPolynomialList.Create;
f.SolvePolynomials(
procedure
begin
Writeln('Solved');
f.Free;
end);
end;
Solving
Solved
Destroyed
For your code, that means moving both a.Free and f.Free into completion handler.

How to clear pointer in stringlist?

I do not understand where are the objects below and how to clear them?
for example:
public
Alist: TStringlist;
..
procedure TForm1.FormCreate(Sender: TObject);
begin
Alist:=Tstringlist.Create;
end;
procedure TForm1. addinstringlist;
var
i: integer;
begin
for i:=0 to 100000 do
begin
Alist.add(inttostr(i), pointer(i));
end;
end;
procedure TForm1.clearlist;
begin
Alist.clear;
// inttostr(i) are cleared, right?
// Where are pointer(i)? Are they also cleared ?
// if they are not cleared, how to clear ?
end;
procedure TForm1. repeat; //newly added
var
i: integer;
begin
For i:=0 to 10000 do
begin
addinstringlist;
clearlist;
end;
end; // No problem?
I use Delphi 7. In delphi 7.0 help file, it says:
AddObject method (TStringList)
Description
Call AddObject to add a string and its associated object to the list.
AddObject returns the index of the new string and object.
Note:
The TStringList object does not own the objects you add this way.
Objects added to the TStringList object still exist
even if the TStringList instance is destroyed.
They must be explicitly destroyed by the application.
In my procedure Alist.add(inttostr(i), pointer(i)), I did not CREATE any object. Were there objects or not ?
how can I clear both inttostr(i) and pointer(i).
Thank you in advance
There is no need to clear Pointer(I) because the pointer does not reference any object. It is an Integer stored as Pointer.
Advice: if you are not sure does your code leak or not write a simple test and use
ReportMemoryLeaksOnShutDown:= True;
If your code leaks you will get a report on closing the test application.
No the code you added does not leak. If your want to check it write a test like this:
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Classes;
var
List: TStringlist;
procedure addinstringlist;
var
i: integer;
begin
for i:=0 to 100 do
begin
List.addObject(inttostr(i), pointer(i));
end;
end;
procedure clearlist;
begin
List.clear;
end;
procedure repeatlist;
var
i: integer;
begin
For i:=0 to 100 do
begin
addinstringlist;
clearlist;
end;
end;
begin
ReportMemoryLeaksOnShutDown:= True;
try
List:=TStringList.Create;
repeatlist;
List.Free;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Try to comment List.Free line to create a memory leak and see what happens.

IdHttpServer form caption not updating

I know i have posted a similar question before but i am not able to get it working I have this simple code :
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S,C : String;
begin
repeat
s := s + AContext.Connection.Socket.ReadChar;
until AContext.Connection.Socket.InputBufferIsEmpty = True;
frmMain.caption := S;
Memo1.Lines.Add(S);
end;
The strings displays ok in the memo but the caption doesn't get updated
TIdHTTPServer is a multi-threaded component. TIdContext runs in its own worker thread. You cannot safely update the Form's Caption (or do anything else with the UI) from outside of the main thread. You need to synchronize with the main thread, such as with the TIdSync or TIdNotify class.
On a side note, calling ReadChar() in a loop is very inefficient, not to mention error-prone if you are using Delphi 2009+ since it cannot return data for surrogate pairs.
Use something more like this instead;
type
TDataNotify = class(TIdNotify)
protected
Data: String;
procedure DoNotify; override;
public
constructor Create(const S: String);
class procedure DataAvailable(const S: String);
end;
constructor TDataNotify.Create(const S: String);
begin
inherited Create;
Data := S;
end;
procedure TDataNotify.DoNotify;
begin
frmMain.Caption := Data;
frmMain.Memo1.Lines.Add(Data);
end;
class procedure TDataNotify.DataAvailable(const S: String);
begin
Create(S).Notify;
end;
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S: String;
begin
AContext.Connection.IOHandler.CheckForDataOnSource(IdTimeoutDefault);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
S := AContext.Connection.IOHandler.InputBufferAsString;
TDataNotify.DataAvailable(S);
end;
end;
First, make sure you are writing to the right variable. Are you sure that frmMain is the form you want the caption do change?
Also, you could try:
procedure TfrmMain.srvrConnect(AContext: TIdContext); //idhttpserver on connect event
var
S,C : String;
begin
repeat
s := s + AContext.Connection.Socket.ReadChar;
until AContext.Connection.Socket.InputBufferIsEmpty = True;
oCaption := S;
TThread.Synchronize(nil, Self.ChangeCaption);
end;
procedure TfrmMain.ChangeCaption;
begin
Self.Caption := oCaption;
Memo1.Lines.Add(oCaption);
end;
And finally, make sure that the first line on S is not a blank line, because the form's caption will not show strings that contains a line feed.

Delphi: invoke constructor raises EInvalidCast

I'm trying to invoke a constructor obtained via RTTI (running D2010 version 14.0.3593.25826). The constructor takes a mixture of strings and objects as its arguments, all of which should be initialized to '' or nil. (Disclaimer: I know that the desired constructor will be the one with maximum number of parameters, hence the weird-looking, although suboptimal design.)
The code goes as follows:
program sb_rtti;
{$APPTYPE CONSOLE}
uses RTTI, TypInfo, SysUtils;
type
TMyClass = class (TObject)
FField1: string;
FObject1: TObject;
public
constructor Create(Field1: string = ''; Object1: TObject = nil);
end;
constructor TMyClass.Create(Field1: string; Object1: TObject);
begin
FField1 := Field1;
FObject1 := Object1;
end;
function GetConstructor(rType: TRttiType) : TRttiMethod;
var
MaxParams: integer;
Methods: TArray<TRttiMethod>;
Method: TRttiMethod;
Params: TArray<TRttiParameter>;
begin
Methods := rType.GetMethods('Create');
MaxParams := 0;
for Method in Methods do begin
Params := Method.GetParameters();
if (Length(Params) > MaxParams) then begin
Result := Method;
MaxParams := Length(Params);
end;
end;
end;
procedure InitializeParam(Param: TRttiParameter; ActualParam: TValue);
begin
if (Param.ParamType.TypeKind = TTypeKind.tkClass) then begin
ActualParam := TValue.From<TObject>(nil);
end else if (Param.ParamType.TypeKind = TTypeKind.tkString) then begin
ActualParam := TValue.From<string>('');
end else if (Param.ParamType.TypeKind = TTypeKind.tkUString) then begin
ActualParam := TValue.From<UnicodeString>('');
end else begin
// Other types goes here
end;
end;
var
Context: TRttiContext;
Constr: TRttiMethod;
Params: TArray<TRttiParameter>;
ResultValue: TValue;
rType: TRttiType;
ActualParams: array of TValue;
i: integer;
CurrentParam: TRttiParameter;
begin
Context := TRttiContext.Create();
rType := Context.GetType(TypeInfo(TMyClass));
Constr := GetConstructor(rType);
try
if (Constr <> nil) then begin
Params := Constr.GetParameters();
SetLength(ActualParams, Length(Params));
for i := 0 to Length(Params) - 1 do begin
CurrentParam := Params[i] as TRttiParameter;
InitializeParam(CurrentParam, ActualParams[i]);
end;
ResultValue := Constr.Invoke(rType.AsInstance.MetaclassType, ActualParams);
end;
except
on E : Exception do
WriteLn(E.ToString);
end;
ReadLn;
end.
Now, when the line ResultValue := Constr.Invoke(rType.AsInstance.MetaclassType, ActualParams); is executed, an EInvalidCast exception is raised. The exception may be traced to the TValue.Cast-method at line 1336.
However, the meat of the problem seems to be found at the previous point in the call stack, more precisely at line 4093 in rtti.pas (argList[currArg] := Args[i].Cast(parList[i].ParamType.Handle);).
My bet is that I'm using rtti in ways I'm not supposed to, yet, I can't find the "right way" described anywhere. Can anybody please point me in the right direction? Thanks!
You have a problem in the InitializeParam procedure because in the assignment of the ActualParam parameter, you are setting the value of the local copy of that parameter – remember that TValue (the type of ActualParam) is a record. So to fix the problem you must pass the ActualParam as a var parameter.
procedure InitializeParam(Param: TRttiParameter; var ActualParam: TValue);
It just occurred to me to hard-code the argument initialization by replacing
for i := 0 to Length(Params) - 1 do begin
CurrentParam := Params[i] as TRttiParameter;
InitializeParam(CurrentParam, ActualParams[i]);
end;
with
ActualParams[0] := TValue.From<string>('');
ActualParams[1] := TValue.From<TObject>(nil);
which solves the problem.

Resources