paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 03:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* improved version that is still readable and has hex inline. Most importantly, it writes directly to result string rather than a temp, saving a copy that is hurting specially for longer strings.

Browse Source
This commit is contained in:
marcoonthegit 2022-05-07 19:05:35 +02:00
parent 62c9e19f39
commit c745e2cfba
1 changed files with 49 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
packages/fcl-json/src/fpjson.pp
View File

@ -801,7 +801,7 @@ Function GetJSONStringParserHandler: TJSONStringParserHandler;
implementation
Uses typinfo;
Uses typinfo,sysconst;
Resourcestring
SErrCannotConvertFromNull = 'Cannot convert data from Null value';
@ -881,57 +881,67 @@ end;
function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
Var
I,J,L, cnt : Integer;
C : Char;
fs:TMemoryStream;
rp,ra,sp,sn,litStart : SizeInt;
outerResult : TJSONStringType absolute result;
procedure W(const ss:string); inline;
procedure W(Ws: PChar; NWs: SizeInt);
begin
fs.Write(ss[1],length(ss));
if ra-rp<NWs then
begin
// rp+NWs are the strict minimum to allocate;
// the rest is a speculation based on the remaining S tail (sn-sp) and the previously allocated value (ra).
ra:=rp+NWs+(sn-sp)+8+SizeInt(SizeUint(ra+(sn-sp)) div 4);
SetLength(outerResult,ra);
end;
Move(Ws^,PChar(pointer(outerResult))[rp],NWS*sizeof(char));
rp:=rp+NWs;
end;
var
hex : array[0..5] of char;
C : Char;
begin
fs:=TMemoryStream.Create;
try
I:=1;
J:=1;
fs.Size:=0;
Result:='';
L:=Length(S);
While I<=L do
begin
C:=S[I];
rp:=0;
ra:=0;
result:='';
sp:=0;
sn:=length(S);
litStart:=0;
hex:='\u00';
While sp<sn do
begin
C:=PChar(pointer(S))[sp];
if (C in ['"','/','\',#0..#31]) then
begin
fs.Write(S[J],I-J); // Result:=Result+Copy(S,J,I-J);
W(PChar(pointer(S))+litStart,sp-litStart);
Case C of
'\' : W('\\'); //Result:=Result+'\\';
'\' : W('\\',2);
'/' : if Strict then
W('\/') //Result:=Result+'\/'
W('\/',2)
else
W('/');//Result:=Result+'/';
'"' : W('\"');//Result:=Result+'\"';
#8 : W('\b');//Result:=Result+'\b';
#9 : W('\t');//Result:=Result+'\t';
#10 : W('\n');//Result:=Result+'\n';
#12 : W('\f');//Result:=Result+'\f';
#13 : W('\r');//Result:=Result+'\r';
W('/',1);
'"' : W('\"',2);
#8 : W('\b',2);
#9 : W('\t',2);
#10 : W('\n',2);
#12 : W('\f',2);
#13 : W('\r',2);
else
W('\u'+HexStr(Ord(C),4)); //Result:=Result+'\u'+HexStr(Ord(C),4);
begin
hex[4]:=hexdigits[(ord(C) shr 4)];
hex[5]:=hexdigits[(ord(C) and $F)];
W(@hex[0],6);
end;
end;
J:=I+1;
litStart:=sp+1;
end;
Inc(I);
end;
//Result:=Result+Copy(S,J,I-1);
cnt:=L-J+1; //
if cnt>0 then
fs.Write(S[J],cnt);
fs.Position:=0;
setstring(Result,Pchar(fs.Memory),fs.Size);
finally
fs.Free;
end;
Inc(sp);
end;
if litStart=0 then
exit(S); // Optimization of the unchanged string case.
W(PChar(pointer(S))+litStart,sp-litStart);
SetLength(result,rp);
end;
function JSONStringToString(const S: TJSONStringType): TJSONStringType;