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

codetools: CompareDottedIdentifiers: check ampersands

Browse Source
This commit is contained in:
mattias 2024-08-05 17:03:15 +02:00
parent cad6e1c374
commit 0004dffe30
2 changed files with 148 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
components/codetools/basiccodetools.pas
View File

@ -192,7 +192,7 @@ function dbgsDiff(Expected, Actual: string): string; overload;
function DottedIdentifierLength(Identifier: PChar): integer;
function GetDottedIdentifier(Identifier: PChar): string;
function IsDottedIdentifier(const Identifier: string): boolean;
function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;
function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer; // compares both to maximum dotted identifier
function CompareDottedIdentifiersCaseSens(Identifier1, Identifier2: PChar): integer;
function ChompDottedIdentifier(const Identifier: string): string;
function SkipDottedIdentifierPart(var Identifier: PChar): boolean;
@ -5255,21 +5255,65 @@ begin
end;
function CompareDottedIdentifiers(Identifier1, Identifier2: PChar): integer;
var
c: Char;
begin
if (Identifier1<>nil) then begin
if (Identifier2<>nil) then begin
while (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) do begin
if (IsDottedIdentChar[Identifier1[0]]) then begin
if (Identifier1<>nil)
and (IsIdentStartChar[Identifier1^]
or ((Identifier1^='&') and IsIdentStartChar[Identifier1[1]])) then
begin
if Identifier1^='&' then inc(Identifier1);
if (Identifier2<>nil)
and (IsIdentStartChar[Identifier2^]
or ((Identifier2^='&') and IsIdentStartChar[Identifier2[1]])) then
begin
if Identifier2^='&' then inc(Identifier2);
while (UpChars[Identifier1^]=UpChars[Identifier2^]) do begin
c:=Identifier1^;
if (IsDottedIdentChar[c]) then begin
inc(Identifier1);
inc(Identifier2);
if c='.' then begin
if Identifier1^='&' then begin
if IsIdentStartChar[Identifier1[1]] then
inc(Identifier1)
else begin
if Identifier2^='&' then
inc(Identifier2);
if IsIdentStartChar[Identifier2^] then
exit(1) // for example 'a.&' 'a.&b'
else
exit(0); // for example 'a.&' 'a.&'
end;
end;
if Identifier2^='&' then begin
if IsIdentStartChar[Identifier2[1]] then
inc(Identifier2)
else
exit(-1); // for example 'a.&b' 'a.&'
end;
if Identifier1^='.' then begin
// '..'
if IsIdentStartChar[Identifier2^] then
exit(1) // for example 'a..' 'a.b'
else
exit(0); // for example 'a..' 'a.1'
end;
if Identifier2^='.' then begin
// '..'
if IsIdentStartChar[Identifier1^] then
exit(-1) // for example 'a.b' 'a..'
else
exit(0); // for example 'a.1' 'a..'
end;
end;
end else begin
Result:=0; // for example 'aaA;' 'aAa;'
exit;
exit(0); // for example 'aaA;' 'aAa;'
end;
end;
if (IsDottedIdentChar[Identifier1[0]]) then begin
if (IsDottedIdentChar[Identifier2[0]]) then begin
if UpChars[Identifier1[0]]>UpChars[Identifier2[0]] then
if (IsDottedIdentChar[Identifier1^]) then begin
if (IsDottedIdentChar[Identifier2^]) then begin
if UpChars[Identifier1^]>UpChars[Identifier2^] then
Result:=-1 // for example 'aab' 'aaa'
else
Result:=1; // for example 'aaa' 'aab'
@ -5277,7 +5321,7 @@ begin
Result:=-1; // for example 'aaa' 'aa;'
end;
end else begin
if (IsDottedIdentChar[Identifier2[0]]) then
if (IsDottedIdentChar[Identifier2^]) then
Result:=1 // for example 'aa;' 'aaa'
else
Result:=0; // for example 'aa;' 'aa,'
@ -5286,7 +5330,10 @@ begin
Result:=-1; // for example 'aaa' nil
end;
end else begin
if (Identifier2<>nil) then begin
if (Identifier2<>nil)
and (IsIdentStartChar[Identifier2^]
or ((Identifier2^='&') and IsIdentStartChar[Identifier2[1]])) then
begin
Result:=1; // for example nil 'bbb'
end else begin
Result:=0; // for example nil nil

89
components/codetools/tests/testbasiccodetools.pas
View File

@ -51,6 +51,7 @@ type
procedure TestStringToPascalConst;
procedure TestReadNextPascalAtom;
procedure TestCompareIdentifiers;
procedure TestCompareDottedIdentifiers;
// FileProcs
procedure TestDateToCfgStr;
procedure TestFilenameIsMatching;
@ -424,6 +425,94 @@ begin
t('&a','&;',-1);
end;
procedure TTestBasicCodeTools.TestCompareDottedIdentifiers;
function GetStr(A: PChar): string;
begin
if A=nil then
Result:='nil'
else if A^=#0 then
Result:='#0'
else
Result:='"'+A+'"';
end;
procedure Test(A, B: PChar; Expected: integer);
var
Actual: Integer;
AmpA, AmpB: string;
begin
Actual:=CompareDottedIdentifiers(A,B);
if Actual<>Expected then
Fail('A='+GetStr(A)+' B='+GetStr(B)+', expected '+dbgs(Expected)+', but got '+dbgs(Actual));
if (A<>nil) and (IsIdentStartChar[A^]) then begin
AmpA:='&'+A;
Test(PChar(AmpA),B,Expected);
if (B<>nil) and (IsIdentStartChar[B^]) then begin
AmpB:='&'+B;
Test(PChar(AmpA),PChar(AmpB),Expected);
end;
end;
end;
procedure t(A, B: PChar; Expected: integer);
begin
Test(A,B,Expected);
Test(B,A,-Expected);
end;
begin
t(nil,nil,0);
t(nil,#0,0);
t(nil,#1,0);
t(#0,#0,0);
t(#0,#1,0);
t(#1,#2,0);
t('a',nil,-1);
t('a',#0,-1);
t('a','a',0);
t('a','A',0);
t('aa','aa',0);
t('aa','Aa',0);
t('aa','AA',0);
t('aa','a',-1);
t('ab','a',-1);
t('ab','a;',-1);
t('ab','aa',-1);
t('ab','aaa',-1);
t('ab;','ab',0);
t('ab;','ab,',0);
t('aAa;','aaA',0);
t('i','I',0);
t('a',';',-1);
t('1','2',0);
t(',',',',0);
t(',',';',0);
t('&',nil,0);
t('&',#0,0);
t('&','&',0);
t('&a','&',-1);
t('&a','&;',-1);
// dotted
t('a','a.b',1);
t('a.b','a.b',0);
t('a.b','a.b.c',1);
t('a.B','A.b',0);
t('a.&B','A.b',0);
t('A..b','a..B',0); // compares only A.
t('A..&b','a..B',0); // compares only A.
t('A..b','a..c',0); // compares only A.
t('A..&b','a..c',0); // compares only A.
t('a.&B','A.c',1);
t('a.&B','A.&c',1);
t('a.&B','A.&b',0);
t('a.&','a.c',1); // compares 'a.' and 'a.c'
t('a.&','a.&c',1); // compares 'a.' and 'a.&c'
t('a.&','a.&1',0); // compares 'a.' and 'a.'
end;
procedure TTestBasicCodeTools.TestDateToCfgStr;
procedure t(const Date: TDateTime; const aFormat, Expected: string);