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

TAChart: Fix merging of intervals in TIntervalList, add test case. Issue #35268, part of "patch2" by Marcin Wiazowski

Browse Source 
git-svn-id: trunk@60788 -
This commit is contained in:
wp 2019-03-27 22:43:18 +00:00
parent 2c3ac872b4
commit 2e629563b1
2 changed files with 33 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
components/tachart/tachartutils.pas
View File

@ -715,16 +715,24 @@ begin
if not (ioOpenStart in ALimits) then AStart -= FEpsilon; if not (ioOpenStart in ALimits) then AStart -= FEpsilon;
if not (ioOpenEnd in ALimits) then AEnd += FEpsilon; if not (ioOpenEnd in ALimits) then AEnd += FEpsilon;
if AStart > AEnd then exit; if AStart > AEnd then exit;
i := 0;
while (i <= High(FIntervals)) and (FIntervals[i].FEnd < AStart) do // In most cases we will be adding ranges in the ascending order,
i += 1; // so the code here is optimized for this case
// Find index of the first interval, having its FEnd >= AStart
i := High(FIntervals) + 1;
while (i > 0) and (FIntervals[i-1].FEnd >= AStart) do
i -= 1;
if i <= High(FIntervals) then if i <= High(FIntervals) then
AStart := Min(AStart, FIntervals[i].FStart); AStart := Min(AStart, FIntervals[i].FStart);
// Find index of the last interval, having its FStart <= AEnd
j := High(FIntervals); j := High(FIntervals);
while (j >= 0) and (FIntervals[j].FStart > AEnd) do while (j >= 0) and (FIntervals[j].FStart > AEnd) do
j -= 1; j -= 1;
if j >= 0 then if j >= 0 then
AEnd := Max(AEnd, FIntervals[j].FEnd); AEnd := Max(AEnd, FIntervals[j].FEnd);
if i < j then begin if i < j then begin
for k := j + 1 to High(FIntervals) do for k := j + 1 to High(FIntervals) do
FIntervals[i + k - j] := FIntervals[j]; FIntervals[i + k - j] := FIntervals[j];
@ -774,31 +782,24 @@ end;
function TIntervalList.Intersect( function TIntervalList.Intersect(
var ALeft, ARight: Double; var AHint: Integer): Boolean; var ALeft, ARight: Double; var AHint: Integer): Boolean;
var
fi, li: Integer;
begin begin
Result := false; Result := false;
if Length(FIntervals) = 0 then exit; if (Length(FIntervals) = 0) or (ALeft > ARight) then exit;
AHint := EnsureRange(AHint, 0, High(FIntervals)); AHint := EnsureRange(AHint, 0, High(FIntervals));
while (AHint > 0) and (FIntervals[AHint].FStart >= ARight) do while (AHint > 0) and (FIntervals[AHint].FStart > ALeft) do
Dec(AHint); Dec(AHint);
while while
(AHint <= High(FIntervals)) and (FIntervals[AHint].FStart < ARight) (AHint <= High(FIntervals)) and (FIntervals[AHint].FStart < ARight)
do begin do begin
if FIntervals[AHint].FEnd > ALeft then begin if FIntervals[AHint].FEnd > ALeft then begin
if not Result then fi := AHint; ALeft := FIntervals[AHint].FStart;
li := AHint; ARight := FIntervals[AHint].FEnd;
Result := true; exit(true);
end; end;
Inc(AHint); Inc(AHint);
end; end;
if Result then begin
ALeft := FIntervals[fi].FStart;
ARight := FIntervals[li].FEnd;
end;
end; end;
procedure TIntervalList.SetOnChange(AValue: TNotifyEvent); procedure TIntervalList.SetOnChange(AValue: TNotifyEvent);

17
components/tachart/test/UtilsTest.pas
View File

@ -151,6 +151,23 @@ begin
AssertTrue(FIList.Intersect(l, r, hint)); AssertTrue(FIList.Intersect(l, r, hint));
AssertEquals(501.0, l); AssertEquals(501.0, l);
AssertEquals(502.0, r); AssertEquals(502.0, r);
FIList.Epsilon := DEFAULT_EPSILON; // don't alter other tests
FIList.Clear;
FIList.AddRange(10.0, 20.0, [ioOpenStart, ioOpenEnd]);
FIList.AddRange(30.0, 40.0, [ioOpenStart, ioOpenEnd]);
l := 0.0;
r := 100.0;
hint := 0;
AssertTrue(FIList.Intersect(l, r, hint));
AssertEquals(10.0, l);
AssertEquals(20.0, r);
l := 0.0;
r := 100.0;
hint := 1;
AssertTrue(FIList.Intersect(l, r, hint));
AssertEquals(10.0, l);
AssertEquals(20.0, r);
end; end;
procedure TIntervalListTest.Merge; procedure TIntervalListTest.Merge;