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

* applied patch from Alexey for closes #39704

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
rtl/objpas/sysutils/syshelp.inc
View File

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

67
tests/test/units/sysutils/tstringhelperjoin.pp Normal file
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.