paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 03:21:44 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger-test-base: reduce large string ops // collecting thousands of strings is better done in a list.

Browse Source 
git-svn-id: trunk@62016 -
This commit is contained in:
martin 2019-10-09 20:06:27 +00:00
parent 9bdf6eb943
commit 9593489f2f
1 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
components/lazdebuggers/lazdebugtestbase/testdbgtestsuites.pas
View File

@ -33,7 +33,8 @@ type
FLogLock: TRTLCriticalSection; FLogLock: TRTLCriticalSection;
FLogFile: TLazLoggerFileHandle; FLogFile: TLazLoggerFileHandle;
FLogFileCreated: Boolean; FLogFileCreated: Boolean;
FLogFileName, FLogBufferText: String; FLogFileName: String;
FLogBufferText: TStringList;
procedure InitLog; procedure InitLog;
procedure FinishLog; procedure FinishLog;
@ -62,6 +63,8 @@ type
procedure TearDown; override; procedure TearDown; override;
procedure RunTest; override; procedure RunTest; override;
public public
constructor Create; override;
destructor Destroy; override;
function SkipTest: Boolean; virtual; function SkipTest: Boolean; virtual;
Procedure TestCompile(const PrgName: string; out ExeName: string; NamePostFix: String=''; ExtraArgs: String=''); overload; Procedure TestCompile(const PrgName: string; out ExeName: string; NamePostFix: String=''; ExtraArgs: String=''); overload;
Procedure TestCompile(const PrgName: string; out ExeName: string; const UsesDirs: array of TUsesDir; Procedure TestCompile(const PrgName: string; out ExeName: string; const UsesDirs: array of TUsesDir;
@ -193,6 +196,7 @@ begin
inc(FIgnoredErrorCnt); inc(FIgnoredErrorCnt);
end else begin end else begin
FTestErrors := FTestErrors + IntToStr(FTestCnt) + ': ' + s + LineEnding; FTestErrors := FTestErrors + IntToStr(FTestCnt) + ': ' + s + LineEnding;
DebugLn(['!!!!! ERROR: ' + IntToStr(FTestCnt) + ': ' + s]);
inc(FTestErrorCnt); inc(FTestErrorCnt);
end; end;
end; end;
@ -458,7 +462,7 @@ end;
procedure TDBGTestCase.InitLog; procedure TDBGTestCase.InitLog;
begin begin
FLogFileCreated := False; FLogFileCreated := False;
FLogBufferText := ''; FLogBufferText.Clear;
end; end;
procedure TDBGTestCase.CreateLog; procedure TDBGTestCase.CreateLog;
@ -494,9 +498,9 @@ begin
//Rewrite(FLogFile); //Rewrite(FLogFile);
FLogFileCreated := True; FLogFileCreated := True;
FLogFile.WriteLnToFile(FLogBufferText); FLogFile.WriteLnToFile(FLogBufferText.Text);
//writeln(FLogFile, FLogBufferText); //writeln(FLogFile, FLogBufferText);
FLogBufferText := ''; FLogBufferText.Clear;
finally finally
LeaveCriticalsection(FLogLock); LeaveCriticalsection(FLogLock);
end; end;
@ -513,7 +517,7 @@ begin
sleep(5); sleep(5);
RenameFileUTF8(FLogFileName + '.log.running', NewName + '.log'); RenameFileUTF8(FLogFileName + '.log.running', NewName + '.log');
end; end;
FLogBufferText := ''; FLogBufferText.Clear;
end; end;
function EscapeText(s: String): String; function EscapeText(s: String): String;
@ -532,9 +536,9 @@ begin
else begin else begin
EnterCriticalsection(FLogLock); EnterCriticalsection(FLogLock);
try try
if length(FLogBufferText) > 20000000 then if FLogBufferText.Count > 500000 then
Delete(FLogBufferText, 1 , Length(s + LineEnding)); FLogBufferText.Delete(1);
FLogBufferText := FLogBufferText + EscapeText(s) + LineEnding; FLogBufferText.Add(EscapeText(s));
finally finally
LeaveCriticalsection(FLogLock); LeaveCriticalsection(FLogLock);
end; end;
@ -617,6 +621,18 @@ begin
end; end;
end; end;
constructor TDBGTestCase.Create;
begin
inherited Create;
FLogBufferText := TStringList.Create;
end;
destructor TDBGTestCase.Destroy;
begin
FreeAndNil(FLogBufferText);
inherited Destroy;
end;
function TDBGTestCase.SkipTest: Boolean; function TDBGTestCase.SkipTest: Boolean;
begin begin
Result := not( Result := not(