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

* Merging revisions r46412,r46413 from trunk:

Browse Source 
------------------------------------------------------------------------
    r46412 | michael | 2020-08-13 12:14:13 +0200 (Thu, 13 Aug 2020) | 1 line
    
    * Avoid reallocating string when parsing unicode char (bug ID 0037562)
    ------------------------------------------------------------------------
    r46413 | michael | 2020-08-13 12:15:19 +0200 (Thu, 13 Aug 2020) | 1 line
    
    * Fix memleak
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46639 -
This commit is contained in:
michael 2020-08-23 10:25:14 +00:00
parent 31c847c3d9
commit 09a846ba71
2 changed files with 40 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -939,10 +939,35 @@ begin
Raise EConvertError.Create('Invalid JSON String:'+S);
end;
{$ELSE}
function BufferHexToInt(P : PAnsiChar): integer;
var
N, i: integer;
ch: char;
begin
Result:= 0;
for i:= 1 to 4 do
begin
ch:= p^;
case ch of
'0'..'9':
N:= Ord(ch)-Ord('0');
'a'..'f':
N:= Ord(ch)-(Ord('a')-10);
'A'..'F':
N:= Ord(ch)-(Ord('A')-10);
else
exit(-1);
end;
Inc(P);
Result:= Result*16+N;
end;
end;
Var
I,J,L,U1,U2 : Integer;
App,W : String;
App : String;
Procedure MaybeAppendUnicode;
@ -982,9 +1007,10 @@ begin
'f' : App:=#12;
'r' : App:=#13;
'u' : begin
W:=Copy(S,I+1,4);
U2:=BufferHexToInt(PAnsiChar(@S[I+1]));
if U2=-1 then
Raise EJSON.Create('Invalid unicode hex code: '+Copy(S,I+1,4));
Inc(I,4);
u2:=StrToInt('$'+W);
if (U1<>0) then
begin
App:={$IFDEF FPC_HAS_CPSTRING}UTF8Encode({$ENDIF}WideChar(U1)+WideChar(U2){$IFDEF FPC_HAS_CPSTRING}){$ENDIF};

13
packages/fcl-json/src/jsonparser.pp
View File

@ -129,8 +129,17 @@ begin
// Add to existing structural type
if (FStruct is TJSONObject) then
begin
if (Not (joIgnoreDuplicates in options)) or (TJSONObject(FStruct).IndexOfName(FKey)=-1) then
TJSONObject(FStruct).Add(FKey,AValue);
if (Not (joIgnoreDuplicates in options)) then
try
TJSONObject(FStruct).Add(FKey,AValue);
except
AValue.Free;
Raise;
end
else if (TJSONObject(FStruct).IndexOfName(FKey)=-1) then
TJSONObject(FStruct).Add(FKey,AValue)
else
AValue.Free;
FKey:='';
end
else if (FStruct is TJSONArray) then