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

Merged revision(s) 60019 #c627ab92eb, 60033-60034 #dc9a5e764e-#dc9a5e764e from trunk:

Browse Source 
SynEdit: MultiCaret - handle 2 stroke key combos correct. Issue #0034825
........
SynEdit: fix assert/range-check in multi caret. Issue #0030731
........
SynEdit: test for  fix assert/range-check in multi caret. Issue #0030731
........

git-svn-id: branches/fixes_2_0@60039 -
This commit is contained in:
maxim 2019-01-08 21:46:41 +00:00
parent c414ae68cb
commit 4c6ab4b10f
5 changed files with 309 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -4758,6 +4758,7 @@ components/synedit/test/testpaintcolormerging.pas svneol=native#text/pascal
components/synedit/test/testsearch.pas svneol=native#text/pascal
components/synedit/test/testsynbeautifier.pas svneol=native#text/pascal
components/synedit/test/testsyncroedit.pas svneol=native#text/pascal
components/synedit/test/testsynmulticaret.pas svneol=native#text/pascal
components/synedit/test/testsynselection.pas svneol=native#text/pascal
components/synedit/test/testsynsharededits.pas svneol=native#text/pascal
components/synedit/test/testsyntextarea.pas svneol=native#text/pascal

63
components/synedit/synpluginmulticaret.pp
View File

@ -2,7 +2,7 @@ unit SynPluginMultiCaret;
{$mode objfpc}{$H+}
{$DEFINE SynMultiCaretAssert}
{off $DEFINE SynMultiCaretAssert}
{off $DEFINE SynMultiCaretDebug}
{$IfDef SynMultiCaretAssert}
@ -631,9 +631,9 @@ begin
)
)
then
h := Result
h := Result // FCarets[Result] >= (x,y,o)
else
l := Result + 1;
l := Result + 1; // FCarets[Result] < (x,y,o)
Result := cardinal(l + h) div 2;
end;
cp := @FCarets[Result];
@ -1148,7 +1148,6 @@ end;
procedure TSynPluginMultiCaretList.SetCurrentCaretKeepX(AValue: Integer);
begin
FCurrenCaret^.KeepX := AValue;
AdjustAfterChange(FCurrenCaret);
end;
procedure TSynPluginMultiCaretList.AdjustAfterChange(ACaret: PCaretData);
@ -1169,37 +1168,42 @@ begin
if (ACaret > FLowCaret) then begin
NewCaretPos := ACaret - 1;
// Compare with previous Caret in list
if (y <= NewCaretPos^.y) then begin
x := ACaret^.x;
if (y < NewCaretPos^.y) or (x <= NewCaretPos^.x) then begin
o := ACaret^.offs;
if (x < NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o <= NewCaretPos^.offs) )
then begin
// ACaret is <= previous Caret in list
// TODO: If equal, only check for merge
HelpCaretPos := NewCaretPos - 1;
if (HelpCaretPos >= FLowCaret) and
( (y < HelpCaretPos^.y) or
( (y = HelpCaretPos^.y) and
( (x < HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o < HelpCaretPos^.offs) ) )
( (x < HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o <= HelpCaretPos^.offs) ) )
) )
then begin
// ACaret is < pre-previous Caret in list
NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, FLowIndex, ToRawIndex(HelpCaretPos));
if NewCaretIdx > FHighIndex then NewCaretIdx := FHighIndex;
Assert((NewCaretIdx >= FLowIndex) and (NewCaretIdx <= FHighIndex), 'caret idx in range');
NewCaretPos := @FCarets[NewCaretIdx];
end;
if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
if FMergeLock = 0 then
if FMergeLock = 0 then begin
InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
exit;
exit;
end;
end;
v := ACaret^;
{$IfDef SynMultiCaretDebug}
debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]);
debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]);
{$EndIf}
Move(NewCaretPos^, (NewCaretPos+1)^, Pointer(ACaret)-Pointer(NewCaretPos));
NewCaretPos^ := v;
assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil');
assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil Caret changed twice in same iteration');
FCurrenCaret := NewCaretPos; // move down
case FIteratoreMode of
mciUp: FBeforeNextCaret := ACaret; // continue at ACaret+1;
@ -1209,6 +1213,8 @@ begin
inc(FIterationDoneCount);
end;
end;
exit;
end
end;
end;
@ -1216,29 +1222,46 @@ begin
if (ACaret < FHighCaret) then begin
NewCaretPos := ACaret + 1;
// Compare with next Caret in list
if (y >= NewCaretPos^.y) then begin
x := ACaret^.x;
if (y > NewCaretPos^.y) or (x >= NewCaretPos^.x) then begin
o := ACaret^.offs;
if (x > NewCaretPos^.x) or ( (x = NewCaretPos^.x) and (o >= NewCaretPos^.offs) )
then begin
// ACaret is >= next Caret in list
HelpCaretPos := NewCaretPos + 1;
if (HelpCaretPos <= FHighCaret) and
( (y > HelpCaretPos^.y) or
( (y = HelpCaretPos^.y) and
( (x > HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o > HelpCaretPos^.offs) ) )
( (x > HelpCaretPos^.x) or ( (x = HelpCaretPos^.x) and (o >= HelpCaretPos^.offs) ) )
) )
then begin
// ACaret is > post-next Caret in list
NewCaretIdx := FindEqOrNextCaretRawIdx(x,y,o, ToRawIndex(HelpCaretPos), FHighIndex);
if NewCaretIdx < FLowIndex then NewCaretIdx := FLowIndex;
Assert((NewCaretIdx >= FLowIndex + 1) and (NewCaretIdx <= FHighIndex + 1), 'caret idx in range');
{$PUSH}{$R-}
NewCaretPos := @FCarets[NewCaretIdx];
end;
{$POP}
if (NewCaretIdx <= FHighIndex) then begin
if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
if FMergeLock = 0 then begin
InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
exit;
end;
end;
end;
dec(NewCaretPos);
end
else
if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
if FMergeLock = 0 then begin
InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
exit;
end;
end;
if (y = NewCaretPos^.y) and (x = NewCaretPos^.x) and (o = NewCaretPos^.offs) then begin
if FMergeLock = 0 then
InternalRemoveCaretEx(ToRawIndex(ACaret), ToRawIndex(NewCaretPos));
exit;
end;
v := ACaret^;
{$IfDef SynMultiCaretDebug}
debugln(SynMCaretDebug, ['TSynPluginMultiCaretList.AdjustAfterChange ', ToRawIndex(NewCaretPos), ' ',ToRawIndex(ACaret)]);
@ -1246,7 +1269,7 @@ begin
Move((ACaret+1)^, ACaret^, Pointer(NewCaretPos)-Pointer(ACaret));
NewCaretPos^ := v;
assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil');
assert(FBeforeNextCaret=nil, 'TSynPluginMultiCaretList.AdjustAfterChange: FBeforeNextCaret=nil Caret changed twice in same iteration');
FCurrenCaret := NewCaretPos; // move down
case FIteratoreMode of
mciDown: FBeforeNextCaret := ACaret; // continue at ACaret-1;
@ -1919,6 +1942,8 @@ begin
Command := ecNone;
Handled := (Command <> ecNone) or IsStartOfCombo;
if IsStartOfCombo then
ComboKeyStrokes := FKeyStrokes;
end;
procedure TSynCustomPluginMultiCaret.RemoveCaretsInSelection;

10
components/synedit/test/SynTest.lpi
View File

@ -17,9 +17,6 @@
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
@ -51,7 +48,7 @@
<PackageName Value="FCL"/>
</Item5>
</RequiredPackages>
<Units Count="22">
<Units Count="23">
<Unit0>
<Filename Value="SynTest.lpr"/>
<IsPartOfProject Value="True"/>
@ -161,6 +158,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="TestMarkupFoldColoring"/>
</Unit21>
<Unit22>
<Filename Value="testsynmulticaret.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="TestSynMultiCaret"/>
</Unit22>
</Units>
</ProjectOptions>
<CompilerOptions>

2
components/synedit/test/SynTest.lpr
View File

@ -4,7 +4,7 @@ program SynTest;
uses
Interfaces, Forms, GuiTestRunner, TestBase, TestBasicSynEdit, TestNavigation,
TestSynSelection, TestBlockIndent, TestBookMarks, TestSearch,
TestSynSelection, TestSynMultiCaret, TestBlockIndent, TestBookMarks, TestSearch,
TestSynBeautifier, TestTrimSpace, TestSyncroEdit, TestSynTextArea,
TestHighlightPas, TestHighlightXml, TestHighlightMulti, TestMarkupwordGroup,
TestMarkupHighAll, TestFoldedView, TestSynSharedEdits, TestHighlighterLfm,

257
components/synedit/test/testsynmulticaret.pas Normal file
View File

@ -0,0 +1,257 @@
unit TestSynMultiCaret;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testutils, testregistry, SynPluginMultiCaret,
SynEditTypes, LazLoggerBase;
type
{ TTestSynMultCaret }
TTestSynMultCaret = class(TTestCase)
published
procedure TestAdjustAfterChange;
end;
implementation
procedure TTestSynMultCaret.TestAdjustAfterChange;
procedure CreateList(var AList: TSynPluginMultiCaretList; ACount: Integer; AMergeLock: Boolean);
var
i: Integer;
begin
FreeAndNil(AList);
AList := TSynPluginMultiCaretList.Create;
if AMergeLock then
AList.IncMergeLock;
for i := 1 to ACount do
AList.AddCaret(i * 10, 1, 0);
end;
procedure AssertSorted(AName: String; AList: TSynPluginMultiCaretList; ACount: Integer; ADupValue: Integer = -1);
var
i: Integer;
begin
//for i := 0 to AList.Count-1 do DbgOut([AList.CaretFull[i].x, ' ']); debugln('');
AssertEquals(AName + ' Count ', ACount, AList.Count);
for i := 1 to ACount-1 do
AssertTrue(AName + ' Ordered '+IntToStr(i),
(AList.CaretFull[i].x > AList.CaretFull[i-1].x) or
( (ADupValue <> -1) and
(AList.CaretFull[i].x = AList.CaretFull[i-1].x) and (AList.CaretFull[i].x = ADupValue) )
);
end;
var
TestList: TSynPluginMultiCaretList;
p: TLogCaretPoint;
Len, MoveIdx, MoveTo, i, L2: Integer;
s: String;
begin
for Len := 1 to 10 do
for MoveIdx := 0 to Len - 1 do
for MoveTo := 0 to Len + 1 do
try
TestList := nil;
s := Format('L: %d, From: %d, To: %d ', [Len, MoveIdx, MoveTo]);
//DebugLn('TestAdjustAfterChange '+s);
L2 := Len;
If not( (MoveTo = MoveIdx+1) or (MoveTo = 0) or (MoveTo = Len + 1) ) then
dec(L2);
// Modify, no dups
CreateList(TestList, Len, True);
p := TestList.CaretFull[MoveIdx];
p.X := MoveTo * 10 + 1;
TestList.CaretFull[MoveIdx] := p;
AssertSorted('Modify, no dup '+s, TestList, Len);
// Modify, with dups
CreateList(TestList, Len, True);
p := TestList.CaretFull[MoveIdx];
p.X := MoveTo * 10;
TestList.CaretFull[MoveIdx] := p;
AssertSorted('Modify, with dup '+s, TestList, Len, MoveTo * 10);
// Modify, with dups remove
CreateList(TestList, Len, False);
p := TestList.CaretFull[MoveIdx];
p.X := MoveTo * 10;
TestList.CaretFull[MoveIdx] := p;
AssertSorted('Modify, with dup '+s, TestList, L2);
// Iterator Up, no dups
CreateList(TestList, Len, True);
TestList.StartIteratorAtFirst;
for i := 1 to Len do begin
AssertTrue('Iterator Up Continues '+s, TestList.IterateNextUp);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10 + 1;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Up Finished '+s, not TestList.IterateNextUp);
AssertSorted('Iterate up, no dup '+s, TestList, Len);
TestList.StartIteratorAtFirst; // Iterate again / must get all entries
for i := 1 to Len do
AssertTrue('Iterator 2 Up Continues '+s, TestList.IterateNextUp);
AssertTrue('Iterator 2 Up Finished '+s, not TestList.IterateNextUp);
// Iterator Up, with dups
CreateList(TestList, Len, True);
TestList.StartIteratorAtFirst;
for i := 1 to Len do begin
AssertTrue('Iterator Up (dups) Continues '+s, TestList.IterateNextUp);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Up (dups) Finished '+s, not TestList.IterateNextUp);
AssertSorted('Iterate up (dups) '+s, TestList, Len, MoveTo * 10);
TestList.StartIteratorAtFirst; // Iterate again / must get all entries
for i := 1 to Len do
AssertTrue('Iterator 2 Up (dups) Continues '+s, TestList.IterateNextUp);
AssertTrue('Iterator 2 Up (dups) Finished '+s, not TestList.IterateNextUp);
(* Not implemented
// Iterator Up, with dups remove
CreateList(TestList, Len, False);
TestList.StartIteratorAtFirst;
for i := 1 to Len do begin
AssertTrue('Iterator Up (dups) Continues '+s, TestList.IterateNextUp);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Up (dups) Finished '+s, not TestList.IterateNextUp);
AssertSorted('Iterate up (dups) '+s, TestList, L2);
TestList.StartIteratorAtFirst; // Iterate again / must get all entries
for i := 1 to L2 do
AssertTrue('Iterator 2 Up (dups) Continues '+s, TestList.IterateNextUp);
AssertTrue('Iterator 2 Up (dups) Finished '+s, not TestList.IterateNextUp);
*)
// Iterator Down, no dups
CreateList(TestList, Len, True);
TestList.StartIteratorAtLast;
for i := Len downto 1 do begin
AssertTrue('Iterator Down Continues '+s, TestList.IterateNextDown);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10 + 1;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Down Finished '+s, not TestList.IterateNextDown);
AssertSorted('Iterate Down, no dup '+s, TestList, Len);
TestList.StartIteratorAtLast; // Iterate again / must get all entries
for i := 1 to Len do
AssertTrue('Iterator 2 Down Continues '+s, TestList.IterateNextDown);
AssertTrue('Iterator 2 Down Finished '+s, not TestList.IterateNextDown);
// Iterator Down, with dups
CreateList(TestList, Len, True);
TestList.StartIteratorAtLast;
for i := Len downto 1 do begin
AssertTrue('Iterator Down (dups) Continues '+s, TestList.IterateNextDown);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Down (dups) Finished '+s, not TestList.IterateNextDown);
AssertSorted('Iterate Down (dups) '+s, TestList, Len, MoveTo * 10);
TestList.StartIteratorAtLast; // Iterate again / must get all entries
for i := 1 to Len do
AssertTrue('Iterator 2 Down (dups) Continues '+s, TestList.IterateNextDown);
AssertTrue('Iterator 2 Down (dups) Finished '+s, not TestList.IterateNextDown);
(* Not implemented
// Iterator Down, with dups remove
CreateList(TestList, Len, False);
TestList.StartIteratorAtLast;
for i := Len downto 1 do begin
AssertTrue('Iterator Down (dups) Continues '+s, TestList.IterateNextDown);
p := TestList.CurrentCaretFull;
AssertEquals('Iterator Ordered '+s+IntToStr(i), i * 10, TestList.CurrentCaretFull.x);
if i-1 = MoveIdx then begin
p.X := MoveTo * 10;
TestList.CurrentCaretFull := p;
end;
end;
AssertTrue('Iterator Down (dups) Finished '+s, not TestList.IterateNextDown);
AssertSorted('Iterate Down (dups) '+s, TestList, L2);
TestList.StartIteratorAtLast; // Iterate again / must get all entries
for i := 1 to L2 do
AssertTrue('Iterator 2 Down (dups) Continues '+s, TestList.IterateNextDown);
AssertTrue('Iterator 2 Down (dups) Finished '+s, not TestList.IterateNextDown);
*)
finally
TestList.Free;
end;
end;
initialization
RegisterTest(TTestSynMultCaret);
end.