paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 14:07:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Fix writing of control characters (bug ID 29867)

Browse Source 
git-svn-id: trunk@33310 -
This commit is contained in:
michael 2016-03-21 19:29:29 +00:00
parent af1ea62ff7
commit e9cdfaae9f
2 changed files with 36 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -668,6 +668,7 @@ function StringToJSONString(const S: TJSONStringType): TJSONStringType;
Var
I,J,L : Integer;
P : PJSONCharType;
C : AnsiChar;
begin
I:=1;
@ -677,10 +678,11 @@ begin
P:=PJSONCharType(S);
While I<=L do
begin
if (AnsiChar(P^) in ['"','/','\',#8,#9,#10,#12,#13]) then
C:=AnsiChar(P^);
if (C in ['"','/','\',#0..#31]) then
begin
Result:=Result+Copy(S,J,I-J);
Case P^ of
Case C of
'\' : Result:=Result+'\\';
'/' : Result:=Result+'\/';
'"' : Result:=Result+'\"';
@ -689,6 +691,8 @@ begin
#10 : Result:=Result+'\n';
#12 : Result:=Result+'\f';
#13 : Result:=Result+'\r';
else
Result:=Result+'\u'+HexStr(Ord(C),4);
end;
J:=I+1;
end;

30
packages/fcl-json/tests/testjsondata.pp
View File

@ -146,6 +146,7 @@ type
procedure DoTestFloat(F: TJSOnFloat; S: String; OK: Boolean);
published
procedure TestString;
procedure TestControlString;
procedure TestInteger;
procedure TestNegativeInteger;
procedure TestFloat;
@ -1492,6 +1493,35 @@ begin
end;
end;
procedure TTestString.TestControlString;
Var
J : TJSONString;
I : Integer;
T : String;
begin
J:=TJSONString.Create('');
try
For I:=0 to 31 do
begin
J.AsString:='-->'+Char(I)+'<--';
Case I of
8 : T:='\b';
9 : T:='\t';
10 : T:='\n';
12 : T:='\f';
13 : T:='\r';
else
T:='\u'+HexStr(I,4);
end;
AssertEquals('Control char','"-->'+T+'<--"',J.AsJSON);
end;
finally
FreeAndNil(J);
end;
end;
procedure TTestString.TestInteger;
Const