* Solution for solidus character, bug ID #30870

git-svn-id: trunk@34819 -

packages/fcl-json/src/fpjson.pp

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

packages/fcl-json/tests/testjsondata.pp

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