paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 13:32:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Rika: Shorten cutils.compareansistrings, resolves #40213

Browse Source
This commit is contained in:
florian 2023-03-24 22:49:51 +01:00
parent 12bde4e903
commit 3ad8b4199c
1 changed files with 5 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
compiler/cutils.pas
View File

@ -1275,7 +1275,6 @@ implementation
var var
count, count1, count2: integer; count, count1, count2: integer;
begin begin
result := 0;
Count1 := Length(S1); Count1 := Length(S1);
Count2 := Length(S2); Count2 := Length(S2);
if Count1>Count2 then if Count1>Count2 then
@ -1316,31 +1315,12 @@ implementation
{ -1 means p1 < p2 } { -1 means p1 < p2 }
function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint; function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
var var
i,j : longint; cmp : SizeInt;
begin begin
compareansistrings:=0; cmp:=CompareByte(p1^,p2^,min(length1,length2));
j:=min(length1,length2); if cmp=0 then
i:=0; cmp:=length1-length2;
while (i<j) do result:=ord(cmp>0)-ord(cmp<0);
begin
if p1[i]>p2[i] then
begin
compareansistrings:=1;
exit;
end
else
if p1[i]<p2[i] then
begin
compareansistrings:=-1;
exit;
end;
inc(i);
end;
if length1>length2 then
compareansistrings:=1
else
if length1<length2 then
compareansistrings:=-1;
end; end;