paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 00:59:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

Tests, LazDebuggerFp: more aggressive timing/scheduling for faster test runs

Browse Source 
git-svn-id: trunk@64537 -
This commit is contained in:
martin 2021-02-11 22:40:19 +00:00
parent 2ae82698cb
commit f6d3eca79a
2 changed files with 42 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/lazdebuggers/lazdebugtestbase/ttestdbgexecuteables.pas
View File

@ -317,7 +317,7 @@ end;
procedure TTestDbgDebugger.DoBetweenWaitForFinish;
begin
sleep(25);
sleep(3);
end;
function TTestDbgDebugger.MatchesCompiler(ACompiler: TTestDbgCompiler): Boolean;

52
components/lazdebuggers/lazdebugtestbase/ttestwatchutilities.pas
View File

@ -212,7 +212,8 @@ type
function ParseCommaList(AVal: String; out AFoundCount: Integer;
AMaxLen: Integer = -1; AComma: char = ','): TStringArray;
protected
function EvaluateWatch(AWatchExp: PWatchExpectation; AThreadId: Integer; constref CurLoc: TDBGLocationRec): Boolean; virtual;
function EvaluateWatch(AWatchExp: PWatchExpectation; AThreadId: Integer; constref CurLoc: TDBGLocationRec; AWaitForEval: Boolean = True): Boolean; virtual;
function EvaluateExprCmd(AWatchExp: PWatchExpectation; AThreadId: Integer; constref CurLoc: TDBGLocationRec; AWaitForEval: Boolean = True): Boolean; virtual;
procedure WaitWhileEval; virtual;
function TestMatches(Name: string; Expected, Got: string; AContext: TWatchExpTestCurrentData; AIgnoreReason: String): Boolean;
@ -1142,15 +1143,18 @@ begin
end;
function TWatchExpectationList.EvaluateWatch(AWatchExp: PWatchExpectation;
AThreadId: Integer; constref CurLoc: TDBGLocationRec): Boolean;
AThreadId: Integer; constref CurLoc: TDBGLocationRec; AWaitForEval: Boolean
): Boolean;
var
i: Integer;
begin
with CurLoc do
FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
' (AT '+ SrcFile + ':' + IntToStr(SrcLine) +')' +
'###### '+LineEnding);
//with CurLoc do
// FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
// ' (AT '+ SrcFile + ':' + IntToStr(SrcLine) +')' +
// '###### '+LineEnding);
AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Value;
if not AWaitForEval then
exit(True);
for i := 1 to 5 do begin
Application.Idle(False);
@ -1158,12 +1162,23 @@ begin
if Result then break;
WaitWhileEval;
end;
FTest.LogText('<<<<< ' + dbgs(AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Validity) + ': ' +
AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Value );
//FTest.LogText('<<<<< ' + dbgs(AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Validity) + ': ' +
// AWatchExp^.TstWatch.Values[AThreadId, AWatchExp^.TstStackFrame].Value );
end;
function TWatchExpectationList.EvaluateExprCmd(AWatchExp: PWatchExpectation;
AThreadId: Integer; constref CurLoc: TDBGLocationRec; AWaitForEval: Boolean
): Boolean;
var
i: Integer;
begin
Result := true;
if AWatchExp^.EvalCallTestFlags <> [] then begin
// TODO: set thread/stack
with CurLoc do
FTest.LogText('###### ' + AWatchExp^.TstTestName + ' // ' + AWatchExp^.TstWatch.Expression +
' (AT '+ SrcFile + ':' + IntToStr(SrcLine) +')' +
'###### '+LineEnding);
// TODO: set thread/stack
FCurEvalCallWatchExp := AWatchExp;
AWatchExp^.EvalCallResReceived := False;
@ -1171,13 +1186,15 @@ begin
for i := 1 to 5 do begin
Application.Idle(False);
if AWatchExp^.EvalCallResReceived then break;
Result := AWatchExp^.EvalCallResReceived;
if Result then break;
WaitWhileEval;
end;
FTest.LogText('<<<<< CB:'+ dbgs(AWatchExp^.EvalCallResReceived)+ ' Res'+ dbgs(AWatchExp^.EvalCallResSuccess)+
' Tp:'+dbgs(AWatchExp^.EvalCallResDBGType <> nil)+ ' '+ AWatchExp^.EvalCallResText );
end;
FCurEvalCallWatchExp := nil;
end;
@ -2119,10 +2136,23 @@ var
begin
t := LazDebugger.Threads.CurrentThreads.CurrentThreadId;
l := LazDebugger.GetLocation;
// Fire up all watches / so the debugger does not need to wait for the testcase
for i := 0 to Length(FList)-1 do
EvaluateWatch(@FList[i], t, l, False);
// Wait for the results
for i := 0 to Length(FList)-1 do begin
EvaluateWatch(@FList[i], t, l);
if (i mod 16) = 0 then TestLogger.DbgOut('.');
end;
// Eval by ReqCommand
for i := 0 to Length(FList)-1 do begin
EvaluateExprCmd(@FList[i], t, l);
if (i mod 16) = 0 then TestLogger.DbgOut('.');
end;
TestLogger.DebugLn('');
end;