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

SynEdit: PascalHighlighter, improve "class of". Issue #33014

Browse Source
This commit is contained in:
Martin 2025-03-08 11:24:59 +01:00
parent c432571c66
commit 0454d6eacf
2 changed files with 84 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/synedit/synhighlighterpas.pp
View File

@ -1305,7 +1305,8 @@ begin
Result := tkKey;
if not (rsInProcHeader in fRange) then
fRange := fRange + [rsAfterEqualOrColon]; // Identifier for type expected
if (rsAfterClass in fRange) and (tfb = cfbtClass) and
if (tfb = cfbtClass) and
(fRange * [rsAfterClass, rsAfterIdentifierOrValue] = [rsAfterClass]) and
(PasCodeFoldRange.BracketNestLevel = 0)
then begin
// Accidental start of block // End at next semicolon (usually same line)
@ -1788,7 +1789,7 @@ begin
(TopPascalCodeFoldBlockType in [cfbtClass])
then begin
Result := tkModifier;
fRange := fRange + [rsAtClass]; // forward, in case of further class modifiers
fRange := fRange + [rsAtClass, rsAfterIdentifierOrValueAdd]; // forward, in case of further class modifiers
end
else
Result := tkIdentifier;
@ -2317,7 +2318,7 @@ begin
Result := tkModifier;
// type foo = class abstract
if (rsAfterClass in fRange) and (TopPascalCodeFoldBlockType = cfbtClass) then
fRange := fRange + [rsAtClass] // forward, in case of further class modifiers end
fRange := fRange + [rsAtClass, rsAfterIdentifierOrValueAdd] // forward, in case of further class modifiers end
else
// procedure foo; virtual; abstract;
if (fRange * [rsInProcHeader, rsProperty, rsAfterEqualOrColon, rsWasInProcHeader, rsAfterClassMembers] = [rsWasInProcHeader, rsAfterClassMembers]) then

80
components/synedit/test/testhighlightpas.pas
View File

@ -69,6 +69,7 @@ type
procedure TestContextForClassObjRecHelp;
procedure TestContextForClassSection;
procedure TestContextForClassModifier; // Sealed abstract
procedure TestContextForClassOf;
procedure TestContextForClassProcModifier; // virtual override final reintroduce
procedure TestContextForClassHelper;
procedure TestContextForTypeHelper;
@ -2483,6 +2484,85 @@ begin
end;
end;
procedure TTestHighlighterPas.TestContextForClassOf;
procedure SetClassOfText(s: String; s2: String = '');
begin
if s2 = '' then s2 := 'FInt1: String;';
SetLines
([ 'Unit A; interface',
'type',
s, // 2
s2, // 3
'FInt: String;', // 4
'private', // 5
'procedure Foo; abstract;',
'end;',
''
]);
end;
procedure CheckClassOfField(ALine: Integer);
begin
CheckTokensForLine('Fint: integer; '+IntToStr(ALine), ALine, [ tkIdentifier, TK_Colon, tkSpace, tkKey, TK_Semi ]);
AssertEquals('no Fold-OpenCount '+IntToStr(ALine), 0, FTheHighLighter.FoldOpenCount(ALine));
end;
procedure CheckClassOfFold(ALine: Integer; AFold: Boolean);
begin
AssertEquals('Fold-OpenCount 2', 1, FTheHighLighter.FoldOpenCount(2)); // currently always
if AFold then begin
CheckTokensForLine('private '+IntToStr(ALine), ALine, [ tkKey ]);
AssertEquals('Fold-OpenCount '+IntToStr(ALine), 1, FTheHighLighter.FoldOpenCount(ALine));
end
else begin
CheckTokensForLine('private '+IntToStr(ALine), ALine, [ tkIdentifier ]);
AssertEquals('no Fold-OpenCount '+IntToStr(ALine), 0, FTheHighLighter.FoldOpenCount(ALine));
end;
end;
begin
ReCreateEdit;
EnableFolds([cfbtBeginEnd..cfbtNone]);
SetClassOfText('TFoo=class');
CheckClassOfField(3);
CheckClassOfFold(5, True);
SetClassOfText('TFoo=class(TFoo)');
CheckClassOfField(3);
CheckClassOfFold(5, True);
SetClassOfText('TFoo=class()');
CheckClassOfField(3);
CheckClassOfFold(5, True);
SetClassOfText('TFoo=class()', 'private'); // incomplete
CheckClassOfFold(3, True);
CheckClassOfField(4);
CheckClassOfFold(5, True);
SetClassOfText('TFoo=class of');
CheckClassOfField(3);
CheckClassOfFold(5, False);
SetClassOfText('TFoo=class {bar} of');
CheckClassOfField(3);
CheckClassOfFold(5, False);
SetClassOfText('TFoo=class of', 'private');
CheckClassOfFold(3, False);
CheckClassOfField(4);
CheckClassOfFold(5, False);
SetClassOfText('TFoo = class sealed (TBar) of');
CheckClassOfField(3);
CheckClassOfFold(5, True);
SetClassOfText('TFoo = class sealed of');
CheckClassOfField(3);
CheckClassOfFold(5, True);
end;
procedure TTestHighlighterPas.TestContextForClassProcModifier;
var
AFolds: TPascalCodeFoldBlockTypes;