lazutils: TranslateUTF8Chars: ascii with delete

git-svn-id: trunk@39795 -

components/lazutils/laz2_xmlutils.pas

@@ -418,9 +418,43 @@ var
     p:=PChar(s)+OldPos;
   end;
 
-  procedure ReplaceASCII;
+  procedure ReplaceASCIIWithDelete(Src: PChar);
+  var
+    c: Char;
+    Dst: PChar;
+    NewLen: SizeInt;
+    i: SizeInt;
+  begin
+    UniqString(Src);
+    Dst:=Src;
+    while Src^<>#0 do begin
+      c:=Src^;
+      i:=Pos(c,SrcChars);
+      if i<1 then begin
+        // keep character
+        Dst^:=c;
+        inc(Src);
+        inc(Dst);
+      end else begin
+        if i<=length(DstChars) then begin
+          // replace a character
+          Dst^:=DstChars[i];
+          inc(Src);
+          inc(Dst);
+        end else begin
+          // delete a character = skip
+          inc(Src);
+        end;
+      end;
+    end;
+    NewLen:=Dst-PChar(s);
+    SetLength(s,NewLen);
+  end;
+
+  procedure ReplaceASCII;
+  // use a simple byte replace
+  // if a delete is needed then switch to another algorithm
   var
-    OldPos: SizeInt;
     i: SizeInt;
     p: PChar;
   begin
@@ -438,9 +472,10 @@ var
           inc(p);
         end else begin
           // delete a character
-          OldPos:=p-PChar(s);
+          // all following characters are moved
-          Delete(s,OldPos+1,1);
+          // => use an optimized algorithm for this
-          p:=PChar(s)+OldPos;
+          ReplaceASCIIWithDelete(p);
+          exit;
         end;
       end;
     end;

test/lazutils/testlazxml.pas

@@ -69,7 +69,7 @@ procedure TTestLazXML.TestTranslateUTF8Chars;
     h:=s;
     TranslateUTF8Chars(h,SrcChars,DstChars);
     if h=Expected then exit;
-    AssertEquals(Title+' s="'+s+'" SrcChars="'+SrcChars+'" DstChars="'+DstChars+'"',Expected,h);
+    AssertEquals(Title+': s="'+s+'" SrcChars="'+SrcChars+'" DstChars="'+DstChars+'"',Expected,h);
   end;
 
 begin
@@ -77,6 +77,8 @@ begin
   T('nop','a','b','b','a');
   T('a to b','a','a','b','b');
   T('switch a,b','abaa','ab','ba','babb');
+  T('delete a','a','a','','');
+  T('delete a','aba','a','','b');
 end;
 
 initialization