mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 10:49:29 +02:00
* 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:
parent
761f65cef8
commit
533cd82922
@ -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;
|
||||
|
||||
|
||||
|
67
tests/test/units/sysutils/tstringhelperjoin.pp
Normal file
67
tests/test/units/sysutils/tstringhelperjoin.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user