mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-21 05:19:10 +02:00
codetools: CompareIdentifiers: support ampersand identifiers
This commit is contained in:
parent
0f51c593fd
commit
df8ab730bb
@ -221,8 +221,18 @@ end;
|
|||||||
|
|
||||||
function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
|
function CompareIdentifiers(Identifier1, Identifier2: PChar): integer;
|
||||||
begin
|
begin
|
||||||
if (Identifier1<>nil) then begin
|
if (Identifier1<>nil)
|
||||||
if (Identifier2<>nil) then begin
|
and (IsIdentStartChar[Identifier1^]
|
||||||
|
or ((Identifier1^='&') and IsIdentStartChar[Identifier1[1]])) then
|
||||||
|
begin
|
||||||
|
if Identifier1[0]='&' then inc(Identifier1);
|
||||||
|
|
||||||
|
if (Identifier2<>nil)
|
||||||
|
and (IsIdentStartChar[Identifier2^]
|
||||||
|
or ((Identifier2^='&') and IsIdentStartChar[Identifier2[1]])) then
|
||||||
|
begin
|
||||||
|
if Identifier2[0]='&' then inc(Identifier2);
|
||||||
|
|
||||||
while (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) do begin
|
while (UpChars[Identifier1[0]]=UpChars[Identifier2[0]]) do begin
|
||||||
if (IsIdentChar[Identifier1[0]]) then begin
|
if (IsIdentChar[Identifier1[0]]) then begin
|
||||||
inc(Identifier1);
|
inc(Identifier1);
|
||||||
@ -251,7 +261,10 @@ begin
|
|||||||
Result:=-1; // for example 'aaa' nil
|
Result:=-1; // for example 'aaa' nil
|
||||||
end;
|
end;
|
||||||
end else begin
|
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'
|
Result:=1; // for example nil 'bbb'
|
||||||
end else begin
|
end else begin
|
||||||
Result:=0; // for example nil nil
|
Result:=0; // for example nil nil
|
||||||
|
@ -368,37 +368,42 @@ procedure TTestBasicCodeTools.TestCompareIdentifiers;
|
|||||||
procedure Test(A, B: PChar; Expected: integer);
|
procedure Test(A, B: PChar; Expected: integer);
|
||||||
var
|
var
|
||||||
Actual: Integer;
|
Actual: Integer;
|
||||||
//AmpA: string;
|
AmpA, AmpB: string;
|
||||||
begin
|
begin
|
||||||
Actual:=CompareIdentifiers(A,B);
|
Actual:=CompareIdentifiers(A,B);
|
||||||
if Actual<>Expected then
|
if Actual<>Expected then
|
||||||
Fail('A='+GetStr(A)+' B='+GetStr(B)+', expected '+dbgs(Expected)+', but got '+dbgs(Actual));
|
Fail('A='+GetStr(A)+' B='+GetStr(B)+', expected '+dbgs(Expected)+', but got '+dbgs(Actual));
|
||||||
|
|
||||||
//if (A<>nil) and (IsIdentStartChar[A^]) then begin
|
if (A<>nil) and (IsIdentStartChar[A^]) then begin
|
||||||
// AmpA:='&'+A;
|
AmpA:='&'+A;
|
||||||
// Test(PChar(AmpA),B,Expected);
|
Test(PChar(AmpA),B,Expected);
|
||||||
//end;
|
if (B<>nil) and (IsIdentStartChar[B^]) then begin
|
||||||
|
AmpB:='&'+B;
|
||||||
|
Test(PChar(AmpA),PChar(AmpB),Expected);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure t(A, B: PChar; Expected: integer);
|
procedure t(A, B: PChar; Expected: integer);
|
||||||
begin
|
begin
|
||||||
Test(A,B,Expected);
|
Test(A,B,Expected);
|
||||||
if A<>B then
|
Test(B,A,-Expected);
|
||||||
Test(B,A,-Expected)
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
// Note: CompareIdentifiers expects identifiers or empty.
|
|
||||||
// Feeding non identifiers like numbers 1 or octal &1 is not defined.
|
|
||||||
t(nil,nil,0);
|
t(nil,nil,0);
|
||||||
t(nil,#0,1); // current implementation gives 1, but it could be 0, in fact 0 would be better to make sure the empty string is the same
|
t(nil,#0,0);
|
||||||
|
t(nil,#1,0);
|
||||||
t(#0,#0,0);
|
t(#0,#0,0);
|
||||||
t(#0,#1,0);
|
t(#0,#1,0);
|
||||||
t(#1,#2,0);
|
t(#1,#2,0);
|
||||||
t('a',nil,-1);
|
t('a',nil,-1);
|
||||||
t('a',#0,-1);
|
t('a',#0,-1);
|
||||||
t('a','a',0);
|
t('a','a',0);
|
||||||
|
t('a','A',0);
|
||||||
t('aa','aa',0);
|
t('aa','aa',0);
|
||||||
|
t('aa','Aa',0);
|
||||||
|
t('aa','AA',0);
|
||||||
t('aa','a',-1);
|
t('aa','a',-1);
|
||||||
t('ab','a',-1);
|
t('ab','a',-1);
|
||||||
t('ab','a;',-1);
|
t('ab','a;',-1);
|
||||||
@ -407,10 +412,16 @@ begin
|
|||||||
t('ab;','ab',0);
|
t('ab;','ab',0);
|
||||||
t('ab;','ab,',0);
|
t('ab;','ab,',0);
|
||||||
t('aAa;','aaA',0);
|
t('aAa;','aaA',0);
|
||||||
|
t('i','I',0);
|
||||||
t('a',';',-1);
|
t('a',';',-1);
|
||||||
t('1','2',1); // current implementation gives 1, but it could be 0, does not matter
|
t('1','2',0);
|
||||||
t(',',',',0);
|
t(',',',',0);
|
||||||
t(',',';',0);
|
t(',',';',0);
|
||||||
|
t('&',nil,0);
|
||||||
|
t('&',#0,0);
|
||||||
|
t('&','&',0);
|
||||||
|
t('&a','&',-1);
|
||||||
|
t('&a','&;',-1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestBasicCodeTools.TestDateToCfgStr;
|
procedure TTestBasicCodeTools.TestDateToCfgStr;
|
||||||
|
Loading…
Reference in New Issue
Block a user