2
0
Эх сурвалжийг харах

* 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.

marcoonthegit 2 жил өмнө
parent
commit
cb70f9c47d

+ 29 - 17
rtl/objpas/sysutils/syshelp.inc

@@ -369,25 +369,37 @@ end;
 
 class function TStringHelper.Join(const Separator: string;
   const Values: array of string; StartIndex: SizeInt; ACount: SizeInt): string;
-
 Var
-  I,L,VLen : SizeInt;
-
-begin
-  VLen:=High(Values);
-  If (ACount<0) or ((StartIndex>0) and (StartIndex>VLen)) then
+  VLen,I,CountLim,NR,NSep,N : SizeInt;
+  Rp: PChar;
+begin
+  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 - 0
tests/test/units/sysutils/tstringhelperjoin.pp

@@ -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.
+