paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 18:49:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Solution for solidus character, bug ID #30870

Browse Source 
git-svn-id: trunk@34819 -
This commit is contained in:
michael 2016-11-06 17:27:36 +00:00
parent 5693bbf9ad
commit 01550dd625
2 changed files with 35 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -283,6 +283,8 @@ Type
function GetAsJSON: TJSONStringType; override; function GetAsJSON: TJSONStringType; override;
function GetAsString: TJSONStringType; override; function GetAsString: TJSONStringType; override;
procedure SetAsString(const AValue: TJSONStringType); override; procedure SetAsString(const AValue: TJSONStringType); override;
Public
Class var StrictEscaping : Boolean;
public public
Constructor Create(const AValue : TJSONStringType); reintroduce; Constructor Create(const AValue : TJSONStringType); reintroduce;
Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce; Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
@ -588,7 +590,7 @@ Type
Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass; Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass; Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType; Function StringToJSONString(const S : TJSONStringType; Strict : Boolean = False) : TJSONStringType;
Function JSONStringToString(const S : TJSONStringType) : TJSONStringType; Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
Function JSONTypeName(JSONType : TJSONType) : String; Function JSONTypeName(JSONType : TJSONType) : String;
@ -662,7 +664,7 @@ begin
Result:=DefaultJSONInstanceTypes[AType] Result:=DefaultJSONInstanceTypes[AType]
end; end;
function StringToJSONString(const S: TJSONStringType): TJSONStringType; function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
Var Var
I,J,L : Integer; I,J,L : Integer;
@ -683,7 +685,10 @@ begin
Result:=Result+Copy(S,J,I-J); Result:=Result+Copy(S,J,I-J);
Case C of Case C of
'\' : Result:=Result+'\\'; '\' : Result:=Result+'\\';
'/' : Result:=Result+'\/'; '/' : if Strict then
Result:=Result+'\/'
else
Result:=Result+'/';
'"' : Result:=Result+'\"'; '"' : Result:=Result+'\"';
#8 : Result:=Result+'\b'; #8 : Result:=Result+'\b';
#9 : Result:=Result+'\t'; #9 : Result:=Result+'\t';
@ -1087,7 +1092,7 @@ begin
if (I>0) then if (I>0) then
W(','); W(',');
W('"'); W('"');
W(StringToJSONString(O.Names[i])); W(StringToJSONString(O.Names[i],False));
W('":'); W('":');
O.Items[I].DumpJSON(S); O.Items[I].DumpJSON(S);
end; end;
@ -1304,7 +1309,7 @@ end;
function TJSONString.GetAsJSON: TJSONStringType; function TJSONString.GetAsJSON: TJSONStringType;
begin begin
Result:='"'+StringToJSONString(FValue)+'"'; Result:='"'+StringToJSONString(FValue,StrictEscaping)+'"';
end; end;
function TJSONString.GetAsString: TJSONStringType; function TJSONString.GetAsString: TJSONStringType;

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

@ -36,7 +36,7 @@ type
TTestJSONString = Class(TTestCase) TTestJSONString = Class(TTestCase)
Private Private
Procedure TestTo(Const Src,Dest : String); Procedure TestTo(Const Src,Dest : String; Strict : Boolean = False);
Procedure TestFrom(Const Src,Dest : String); Procedure TestFrom(Const Src,Dest : String);
Published Published
Procedure TestJSONStringToString; Procedure TestJSONStringToString;
@ -147,6 +147,7 @@ type
published published
procedure TestString; procedure TestString;
procedure TestControlString; procedure TestControlString;
procedure TestSolidus;
procedure TestInteger; procedure TestInteger;
procedure TestNegativeInteger; procedure TestNegativeInteger;
procedure TestFloat; procedure TestFloat;
@ -1501,7 +1502,6 @@ Var
T : String; T : String;
begin begin
J:=TJSONString.Create(''); J:=TJSONString.Create('');
try try
For I:=0 to 31 do For I:=0 to 31 do
@ -1523,6 +1523,23 @@ begin
end; end;
end; end;
procedure TTestString.TestSolidus;
Var
J : TJSONString;
begin
J:=TJSONString.Create('');
try
J.AsString:='http://www.json.org/';
TJSONString.StrictEscaping:=True;
TestJSON(J,'"http:\/\/www.json.org\/"');
TJSONString.StrictEscaping:=False;
TestJSON(J,'"http://www.json.org/"');
finally
FreeAndNil(J);
end;
end;
procedure TTestString.TestInteger; procedure TTestString.TestInteger;
Const Const
@ -4026,14 +4043,14 @@ end;
{ TTestJSONString } { TTestJSONString }
procedure TTestJSONString.TestTo(const Src, Dest: String); procedure TTestJSONString.TestTo(const Src, Dest: String; Strict : Boolean = False);
Var Var
S : String; S : String;
begin begin
S:='StringToJSONString('''+Src+''')='''+Dest+''''; S:='StringToJSONString('''+Src+''')='''+Dest+'''';
AssertEquals(S,Dest,StringToJSONString(Src)); AssertEquals(S,Dest,StringToJSONString(Src,Strict));
end; end;
procedure TTestJSONString.TestFrom(const Src, Dest: String); procedure TTestJSONString.TestFrom(const Src, Dest: String);
@ -4092,7 +4109,8 @@ begin
TestTo('AB','AB'); TestTo('AB','AB');
TestTo('ABC','ABC'); TestTo('ABC','ABC');
TestTo('\','\\'); TestTo('\','\\');
TestTo('/','\/'); TestTo('/','/');
TestTo('/','\/',True);
TestTo('"','\"'); TestTo('"','\"');
TestTo(#8,'\b'); TestTo(#8,'\b');
TestTo(#9,'\t'); TestTo(#9,'\t');
@ -4115,7 +4133,8 @@ begin
TestTo('A'#12'BC','A\fBC'); TestTo('A'#12'BC','A\fBC');
TestTo('A'#13'BC','A\rBC'); TestTo('A'#13'BC','A\rBC');
TestTo('\\','\\\\'); TestTo('\\','\\\\');
TestTo('//','\/\/'); TestTo('//','//');
TestTo('//','\/\/',true);
TestTo('""','\"\"'); TestTo('""','\"\"');
TestTo(#8#8,'\b\b'); TestTo(#8#8,'\b\b');
TestTo(#9#9,'\t\t'); TestTo(#9#9,'\t\t');