* applied patch from Alexey for closes #39704

* reviewed checks at start of function to match Delphi in rangecheck errors and other exits
 * test for the above.
This commit is contained in:
marcoonthegit 2022-08-17 18:37:31 +02:00
parent 761f65cef8
commit 533cd82922
2 changed files with 95 additions and 16 deletions

View File

@ -376,25 +376,37 @@ end;
class function TStringHelper.Join(const Separator: string;
const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string;
Var
I,L,VLen : SizeInt;
VLen,I,CountLim,NR,NSep,N : SizeInt;
Rp: PChar;
begin
VLen:=High(Values);
If (ACount<0) or ((StartIndex>0) and (StartIndex>VLen)) then
VLen:=System.Length(Values);
If (ACount=0) then
Exit('');
CountLim:=VLen-StartIndex;
if ACount>CountLim then
ACount:=CountLim;
If (ACount<0) or (StartIndex>VLen) then
raise ERangeError.Create(SRangeError);
If (ACount=0) or (VLen<0) then
Result:=''
else
begin
L:=StartIndex+ACount-1;
if L>Vlen then
L:=VLen;
Result:=Values[StartIndex];
For I:=StartIndex+1 to L do
Result:=Result+Separator+Values[I];
end;
if ACount=1 then
exit(Values[StartIndex]);
NSep:=System.Length(Separator);
NR:=(ACount-1)*NSep;
for I:=StartIndex to StartIndex+ACount-1 do
NR:=NR+System.Length(Values[I]);
SetLength(Result,NR);
Rp:=@Result[1];
for I:=StartIndex to StartIndex+ACount-1 do
begin
if I>StartIndex then
begin
Move(separator[1],Rp^,NSep*sizeof(Char));
Rp:=Rp+NSep;
end;
N:=System.Length(Values[I]);
Move(Values[I][1],Rp^,N*sizeof(Char));
Rp:=Rp+N;
end;
end;

View File

@ -0,0 +1,67 @@
program tstringhelperjoin;
{$ifndef fpc}
{$APPTYPE CONSOLE}
{$else}
{$mode delphi}
{$endif}
uses
{$ifndef fpc} System.{$endif}SysUtils;
var testsuccess : boolean;
procedure dojoin(const testname,shouldbe:string;sep:string;some:array of string;start,cnt : integer;isexception:boolean);
var s : string;
res: boolean;
begin
res:=false;
try
s:=s.Join(sep,some,start,cnt);
except
on e : Erangeerror do
res:=true;
end;
if isexception and not res then
begin
testsuccess :=false;
writeln(testname,' FAIL on rangeexception NOT happening while it should')
end
else
if not isexception and res then
begin
testsuccess :=false;
writeln(testname,' FAIL, rangeexception while it shouldn''t')
end
else
if not res and (s<>shouldbe) then
begin
testsuccess :=false;
writeln(testname,' FAIL on result mismatch ' ,s,' should be ',shouldbe);
end
else
writeln(testname,' ok');
end;
begin
testsuccess :=true;
dojoin('default number','String1,String2,String3', ',', ['String1', 'String2', 'String3'],0,3,false);
dojoin('other sep','String2AAString3', 'AA', ['String1', 'String2', 'String3'],1,2,false);
dojoin('index not 0','String2,String3', ',', ['String1', 'String2', 'String3'],1,2,false);
dojoin('no data ','', ',', [],1,2,true);
dojoin('both 0 ','', ',', [],1,0,false);
dojoin('count 0','', ',', ['String1', 'String2', 'String3'],1,0,false);
dojoin('index not 0 overflow','String2,String3', ',', ['String1', 'String2', 'String3'],1,5,false);
dojoin('exception large start','String1,String2,String3', ',', ['String1', 'String2', 'String3'],4,3,true);
dojoin('exception large count','String1,String2,String3', ',', ['String1', 'String2', 'String3'],4,10,true);
{$ifndef fpc}
if debughook>0 then
readln;
{$endif}
if not testsuccess then
halt(1)
else
halt(0);
end.