From f531a8c5630f541653c35d181efa635e684dc883 Mon Sep 17 00:00:00 2001 From: martin Date: Sat, 16 Mar 2019 16:21:01 +0000 Subject: [PATCH] SynEdit: PasHighLighter, fixed highlighting procedure names in interface declaration. Issue #0035238 git-svn-id: trunk@60700 - --- components/synedit/synhighlighterpas.pp | 8 +- components/synedit/test/SynTest.lpi | 100 +++++++-------- .../synedit/test/testhighlightfoldbase.pas | 89 ++++++++++++- components/synedit/test/testhighlightpas.pas | 121 ++++++++++++++---- 4 files changed, 235 insertions(+), 83 deletions(-) diff --git a/components/synedit/synhighlighterpas.pp b/components/synedit/synhighlighterpas.pp index 228c57161d..857da9c20e 100644 --- a/components/synedit/synhighlighterpas.pp +++ b/components/synedit/synhighlighterpas.pp @@ -1407,7 +1407,7 @@ begin StartPascalCodeFoldBlock(cfbtRecord); fRange := fRange - [rsVarTypeInSpecification]; if CompilerMode = pcmDelphi then - fRange := fRange + [rsAtClass] - [rsAfterEqual]; // highlight helper + fRange := fRange + [rsAtClass] - [rsAfterEqual, rsAfterEqualOrColon]; // highlight helper Result := tkKey; end else if KeyComp('Array') then Result := tkKey @@ -1600,15 +1600,17 @@ begin if rsProperty in fRange then Result := tkKey else Result := tkIdentifier; end else if KeyComp('Interface') then begin - if (rsAfterEqualOrColon in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) + if (rsAfterEqual in fRange) and (PasCodeFoldRange.BracketNestLevel = 0) then begin - fRange := fRange + [rsAtClass]; + // type IFoo = INTERFACE + fRange := fRange + [rsAtClass] - [rsVarTypeInSpecification, rsAfterEqual]; StartPascalCodeFoldBlock(cfbtClass); end else if not(rsAfterEqualOrColon in fRange) and (fRange * [rsInterface, rsImplementation] = []) then begin + // unit section INTERFACE CloseBeginEndBlocksBeforeProc; if TopPascalCodeFoldBlockType in [cfbtVarType, cfbtLocalVarType] then EndPascalCodeFoldBlockLastLine; diff --git a/components/synedit/test/SynTest.lpi b/components/synedit/test/SynTest.lpi index bcc1cfdf92..ecaf29c248 100644 --- a/components/synedit/test/SynTest.lpi +++ b/components/synedit/test/SynTest.lpi @@ -1,7 +1,7 @@ - + @@ -12,8 +12,8 @@ - - + + @@ -48,121 +48,121 @@ - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + diff --git a/components/synedit/test/testhighlightfoldbase.pas b/components/synedit/test/testhighlightfoldbase.pas index 0c8337ec4f..e60fe62cce 100644 --- a/components/synedit/test/testhighlightfoldbase.pas +++ b/components/synedit/test/testhighlightfoldbase.pas @@ -5,8 +5,8 @@ unit TestHighlightFoldBase; interface uses - SysUtils, TestBase, - SynEdit, SynEditHighlighterFoldBase; + SysUtils, TestBase, SynEdit, SynEditHighlighterFoldBase, SynEditHighlighter, + SynEditMiscClasses, LazLoggerBase; type @@ -21,7 +21,17 @@ type type - { TTestBaseHighlighterPas } + TExpTokenInfo = record + ExpKind: Integer; + ExpAttr: TSynHighlighterAttributes; + Flags: set of (etiKind, etiAttr); + end; + +operator := (a: Integer) : TExpTokenInfo; +operator := (a: TSynHighlighterAttributes) : TExpTokenInfo; +operator + (a: Integer; b: TSynHighlighterAttributes) : TExpTokenInfo; + +type { TTestBaseHighlighterFoldBase } @@ -29,6 +39,7 @@ type protected FTheHighLighter: TSynCustomFoldHighlighter; function CreateTheHighLighter: TSynCustomFoldHighlighter; virtual; abstract; + procedure InitTighLighterAttr; virtual; procedure SetUp; override; procedure TearDown; override; procedure ReCreateEdit; reintroduce; @@ -40,12 +51,36 @@ type procedure CheckFoldInfoCounts(Name: String; Filter: TSynFoldActions; Expected: Array of Integer); procedure CheckFoldInfoCounts(Name: String; Filter: TSynFoldActions; Group: Integer; Expected: Array of Integer); + procedure CheckTokensForLine(Name: String; LineIdx: Integer; ExpTokens: Array of TExpTokenInfo); + function FoldActionsToString(AFoldActions: TSynFoldActions): String; end; implementation +operator := (a: Integer) : TExpTokenInfo; +begin + result := default(TExpTokenInfo); + result.ExpKind := a; + result.Flags := [etiKind]; +end; + +operator := (a: TSynHighlighterAttributes) : TExpTokenInfo; +begin + result := default(TExpTokenInfo); + result.ExpAttr := a; + result.Flags := [etiAttr]; +end; + +operator + (a: Integer; b: TSynHighlighterAttributes) : TExpTokenInfo; +begin + result := default(TExpTokenInfo); + result.ExpKind := a; + result.ExpAttr := b; + result.Flags := [etiKind, etiAttr]; +end; + function ExpVLine(ALine: Integer; AExp: array of integer): TTestExpValuesForLine; var i: Integer; @@ -58,6 +93,21 @@ end; { TTestBaseHighlighterFoldBase } +procedure TTestBaseHighlighterFoldBase.InitTighLighterAttr; +var + i: Integer; +begin + for i := 0 to FTheHighLighter.AttrCount - 1 do begin + DebugLn(['# ', i, ' ', FTheHighLighter.Attribute[i].StoredName]); + FTheHighLighter.Attribute[i].Foreground := 10000 + i; // unique foreground colors + FTheHighLighter.Attribute[i].Foreground := 10000 + i; // unique foreground colors + if FTheHighLighter.Attribute[i] is TSynHighlighterAttributesModifier then begin + TSynHighlighterAttributesModifier(FTheHighLighter.Attribute[i]).ForeAlpha := 0; + TSynHighlighterAttributesModifier(FTheHighLighter.Attribute[i]).ForePriority := 100+i; + end; + end; +end; + procedure TTestBaseHighlighterFoldBase.SetUp; begin FTheHighLighter := nil; @@ -79,6 +129,7 @@ begin FreeAndNil(FTheHighLighter); inherited ReCreateEdit; FTheHighLighter := CreateTheHighLighter; + InitTighLighterAttr; SynEdit.Highlighter := FTheHighLighter; end; @@ -142,6 +193,38 @@ begin end; end; +procedure TTestBaseHighlighterFoldBase.CheckTokensForLine(Name: String; + LineIdx: Integer; ExpTokens: array of TExpTokenInfo); + + function AttrVal(a: TSynHighlighterAttributes): Integer; + begin + if a = nil then exit(-1); + if a is TSynSelectedColorMergeResult then + TSynSelectedColorMergeResult(a).ProcessMergeInfo; + Result := a.Foreground; // compare the color + end; +var + c: Integer; + e: TExpTokenInfo; +begin + FTheHighLighter.StartAtLineIndex(LineIdx); + c := 0; + while not FTheHighLighter.GetEol do begin + e := ExpTokens[c]; + //DebugLn([FTheHighLighter.GetToken,' (',FTheHighLighter.GetTokenKind ,') at ', FTheHighLighter.GetTokenPos]); + if etiKind in e.Flags then + AssertEquals(Name + ' Kind @ TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c), e.ExpKind, FTheHighLighter.GetTokenKind); + if etiAttr in e.Flags then + AssertEquals(Name + ' Attr @ TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c), AttrVal(e.ExpAttr), AttrVal(FTheHighLighter.GetTokenAttribute)); + + FTheHighLighter.Next; + inc(c); + if c >= length(ExpTokens) then + break; + end; + AssertEquals(Name+ 'TokenId Line='+IntToStr(LineIdx)+' amount of tokens', length(ExpTokens), c ); +end; + function TTestBaseHighlighterFoldBase.FoldActionsToString(AFoldActions: TSynFoldActions): String; var s: string; diff --git a/components/synedit/test/testhighlightpas.pas b/components/synedit/test/testhighlightpas.pas index beadd4de3f..e8b5abf771 100644 --- a/components/synedit/test/testhighlightpas.pas +++ b/components/synedit/test/testhighlightpas.pas @@ -5,8 +5,9 @@ unit TestHighlightPas; interface uses - Classes, SysUtils, testregistry, TestBase, Forms, LCLProc, TestHighlightFoldBase, - SynEdit, SynEditTypes, SynHighlighterPas, SynEditHighlighterFoldBase; + Classes, SysUtils, testregistry, TestBase, Forms, LCLProc, + TestHighlightFoldBase, SynEdit, SynEditTypes, SynHighlighterPas, + SynEditHighlighterFoldBase, SynEditHighlighter; type @@ -47,13 +48,13 @@ type function TestTextFoldInfo4(AIfCol: Integer): TStringArray; function TestTextFoldInfo5: TStringArray; - procedure CheckTokensForLine(Name: String; LineIdx: Integer; ExpTokens: Array of TtkTokenKind); published procedure TestFoldInfo; procedure TestExtendedKeywordsAndStrings; procedure TestContextForProcModifiers; procedure TestContextForProperties; procedure TestContextForProcedure; + procedure TestContextForInterface; procedure TestContextForDeprecated; procedure TestContextForClassModifier; // Sealed abstract procedure TestContextForClassHelper; @@ -67,6 +68,21 @@ type implementation +operator := (a: TtkTokenKind) : TExpTokenInfo; +begin + result := default(TExpTokenInfo); + result.ExpKind := ord(a); + result.Flags := [etiKind]; +end; + +operator + (a: TtkTokenKind; b: TSynHighlighterAttributes) : TExpTokenInfo; +begin + result := default(TExpTokenInfo); + result.ExpKind := ord(a); + result.ExpAttr := b; + result.Flags := [etiKind, etiAttr]; +end; + { TTestBaseHighlighterPas } function TTestBaseHighlighterPas.PasHighLighter: TSynPasSyn; @@ -287,24 +303,6 @@ begin Result[12] := ''; end; -procedure TTestHighlighterPas.CheckTokensForLine(Name: String; LineIdx: Integer; - ExpTokens: array of TtkTokenKind); -var - c: Integer; -begin - PasHighLighter.StartAtLineIndex(LineIdx); - c := 0; - while not PasHighLighter.GetEol do begin - //DebugLn([PasHighLighter.GetToken,' (',PasHighLighter.GetTokenID ,') at ', PasHighLighter.GetTokenPos]); - AssertEquals(Name + 'TokenId Line='+IntToStr(LineIdx)+' pos='+IntToStr(c), ord(ExpTokens[c]), ord(PasHighLighter.GetTokenID)); - PasHighLighter.Next; - inc(c); - if c >= length(ExpTokens) then - break; - end; - AssertEquals(Name+ 'TokenId Line='+IntToStr(LineIdx)+' amount of tokens', length(ExpTokens), c ); -end; - procedure TTestHighlighterPas.TestFoldInfo; begin ReCreateEdit; @@ -665,12 +663,24 @@ begin end; procedure TTestHighlighterPas.TestContextForProcedure; +var + AtP, AtI, AtK: TSynHighlighterAttributes; begin ReCreateEdit; + AtP := PasHighLighter.ProcedureHeaderName; + AtI := PasHighLighter.IdentifierAttri; + AtK := PasHighLighter.KeywordAttribute; + SetLines ([ 'Unit A;', 'interface', '', + 'type', + ' IBar = interface', + ' procedure p1;', + ' procedure p2;', + ' end;', + '', 'var', ' Foo: Procedure of object;', // no folding // do not end var block '', @@ -699,16 +709,73 @@ begin '' ]); EnableFolds([cfbtBeginEnd..cfbtNone]); - CheckFoldOpenCounts('', [ 1, 1, 0, 1 {var}, 0, 0, 1 {type}, 0, 0, 0, 0 {Proc}, 0, + CheckFoldOpenCounts('', [ 1, 1, 0, + 1 {type}, 1, 0, 0, 0, 0, + 1 {var}, 0, 0, 1 {type}, 0, 0, 0, + 0 {Proc}, 0, 1 {impl}, 0, 1 {var}, 0, 0, 1 {type}, 0, 0, 0, 1 {proc}, 1 {var}, 0, 0, 0, 0, 0 ]); - AssertEquals('Len var 1 ', 2, PasHighLighter.FoldLineLength(3, 0)); - AssertEquals('Len type 1 ', 3, PasHighLighter.FoldLineLength(6, 0)); - AssertEquals('Len var 2 ', 2, PasHighLighter.FoldLineLength(14, 0)); - AssertEquals('Len type 2 ', 3, PasHighLighter.FoldLineLength(17, 0)); - AssertEquals('Len var 3 ', 2, PasHighLighter.FoldLineLength(22, 0)); + AssertEquals('Len var 1 ', 2, PasHighLighter.FoldLineLength(9, 0)); + AssertEquals('Len type 1 ', 3, PasHighLighter.FoldLineLength(12, 0)); + AssertEquals('Len var 2 ', 2, PasHighLighter.FoldLineLength(20, 0)); + AssertEquals('Len type 2 ', 3, PasHighLighter.FoldLineLength(23, 0)); + AssertEquals('Len var 3 ', 2, PasHighLighter.FoldLineLength(28, 0)); + + CheckTokensForLine('IBar.p1', 5, [ tkSpace, tkKey + AtK, tkSpace, tkIdentifier + AtP, tkSymbol ]); + CheckTokensForLine('IBar.p2', 6, [ tkSpace, tkKey + AtK, tkSpace, tkIdentifier + AtP, tkSymbol ]); + CheckTokensForLine('foo p of', 10, [ tkSpace, tkIdentifier, tkSymbol, tkSpace, + tkKey + AtK, tkSpace, tkKey + AtK {of}, tkSpace, tkKey, tkSymbol + ]); + CheckTokensForLine('TBar', 14, [ tkSpace, tkKey + AtK, tkSymbol, tkSymbol, tkSymbol, + tkSpace, tkIdentifier + AtI, tkSymbol + ]); + + +end; + +procedure TTestHighlighterPas.TestContextForInterface; +var + AtP, AtI, AtK: TSynHighlighterAttributes; +begin + ReCreateEdit; + AtK := PasHighLighter.KeywordAttribute; + + SetLines + ([ 'Unit A;', + 'interface', + '', + 'type', + ' IBar = interface', + ' procedure p1;', + ' procedure p2;', + ' end;', + '', + 'var', + ' IBar2: interface', // not allowed "anonymous class" + ' procedure p1;', + ' procedure p2;', + '', + 'implementation', + '' + ]); + EnableFolds([cfbtBeginEnd..cfbtNone]); + CheckFoldOpenCounts('', [ 1, 1, 0, + 1 {type}, 1, 0, 0, 0, 0, + 1 {var}, 0, 0, 0, 0, 0 + // implementation + ]); + AssertEquals('Len type ', 5, PasHighLighter.FoldLineLength(3, 0)); + AssertEquals('Len intf ', 3, PasHighLighter.FoldLineLength(4, 0)); + AssertEquals('Len var ', 1, PasHighLighter.FoldLineLength(9, 0)); // ends at next procedure + + CheckTokensForLine('unit "interface"', 1, + [ tkKey + AtK ]); + CheckTokensForLine('type "interface"', 4, + [ tkSpace, tkIdentifier, tkSpace, tkSymbol, tkSpace, tkKey + AtK ]); + CheckTokensForLine('var "interface"', 10, + [ tkSpace, tkIdentifier, tkSymbol, tkSpace, tkKey + AtK ]); // not allowed, still a keyword end; procedure TTestHighlighterPas.TestContextForDeprecated;