I know you are coding in Lazarus - but Lazarus - even simplified adds
layers of stuff - is there anyway you can make your core functionality
reside in a UNIT - and then make a console app test application that
puts it through its paces.... then if it works - link it in to your
"Lazarus GUI in Development" ?
I made another test program, in console mode with critical sections,
but it still happens (but not so often).
It should be attached
I also see potential issue here:
Begin ---- Snippet
procedure TForm1.testTerminate(Sender: TObject);
begin
if (sender is ttestthread) then
memo1.lines.add(ttestthread(sender).result);
end;
End ---- Snippet
This shouldn't be problematic, because onTerminate
is guaranteed to be called in the main thread
However, perhaps it doesn't have to do anything with threads,
but with network load, because the transmission also fails
sometimes, if I start several single-threaded processes.
Perhaps the connect timeout is too low?
Benito
program synat2;
{$mode objfpc}{$H+}
uses
cthreads,Interfaces,
Classes,httpsend,sysutils,forms;
var
critSec: TRTLCriticalSection;
type
{ ttestthread }
ttestthread=class(Tthread)
url,result:string;
procedure execute;override;
end;
{ ttestreceiver }
ttestreceiver=class
procedure onterminate(Sender: TObject);
end;
var testreceiver:ttestreceiver;
i: Integer;
{ ttestreceiver }
procedure ttestreceiver.onterminate(Sender: TObject);
begin
EnterCriticalsection(critSec);
if not (sender is ttestthread) then writeln('MISSION IMPOSSIBLE');
writeln (GetThreadID,':',(sender as ttestthread).url,':', (sender as
ttestthread).result);
LeaveCriticalsection(critSec);
end;
{ ttestthread }
function getUrl(url:string):string;
var
temp: TStringList;
begin
temp:=TStringList.create;
try
HttpGetText(url,temp);
if temp.Count<1 then result:='empty:'+IntToStr(temp.Count)
else result:='got:'+temp[0]+temp[1];
finally
temp.free;
end;
end;
procedure ttestthread.execute;
begin
result:=getUrl(url);
end;
procedure simpleTest(url:string);
var
test: ttestthread;
begin
test:=ttestthread.Create(true);
test.url:=url;
test.Result:='wtf';
test.OnTerminate:[email protected];
test.Resume;
end;
procedure multiTest(url:string;count:longint=10);
var
i: Integer;
begin
for i:=1 to count do
simpleTest(url);
end;
begin
InitCriticalSection(critSec);
{for i:=1 to 50 do begin
writeln(getUrl('http://www.google.com'));
writeln(getUrl('http://www.spiegel.de'));
end; }
{multiTest('http://www.spiegel.de');
multiTest('http://www.google.com');
multiTest('http://www.spiegel.de');
multiTest('http://www.google.com');
}
while true do begin
Sleep(100);
Application.ProcessMessages;
end;
DoneCriticalsection(critSec);
end.
------------------------------------------------------------------------------
SOLARIS 10 is the OS for Data Centers - provides features such as DTrace,
Predictive Self Healing and Award Winning ZFS. Get Solaris 10 NOW
http://p.sf.net/sfu/solaris-dev2dev
_______________________________________________
synalist-public mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/synalist-public
