* Add option to ignore trailing commas in objects and arrays

git-svn-id: trunk@32875 -

packages/fcl-json/src/jsonparser.pp

@@ -238,8 +238,10 @@ Var
   T : TJSONtoken;
   E : TJSONData;
   N : String;
-  
+  LastComma : Boolean;
+
 begin
+  LastComma:=False;
   Result:=CreateJSONObject([]);
   Try
     T:=GetNextToken;
@@ -257,8 +259,13 @@ begin
       If Not (T in [tkComma,tkCurlyBraceClose]) then
         DoError(SExpectedCommaorBraceClose);
       If T=tkComma then
+        begin
         T:=GetNextToken;
+        LastComma:=(t=tkCurlyBraceClose);
+        end;
       end;
+    If LastComma and ((joStrict in Options) or not (joIgnoreTrailingComma in Options))  then // Test for ,} case
+      DoError(SErrUnExpectedToken);
   Except
     FreeAndNil(Result);
     Raise;
@@ -272,7 +279,7 @@ Var
   T : TJSONtoken;
   E : TJSONData;
   LastComma : Boolean;
-  
+  S : TJSONOPTions;
 begin
   Result:=CreateJSONArray([]);
   LastComma:=False;
@@ -292,7 +299,8 @@ begin
         LastComma:=(t=TkComma);
         end;
     Until (T=tkSquaredBraceClose);
-    If LastComma then // Test for ,] case
+    S:=Options;
+    If LastComma and ((joStrict in S) or not (joIgnoreTrailingComma in S))  then // Test for ,] case
       DoError(SErrUnExpectedToken);
   Except
     FreeAndNil(Result);

packages/fcl-json/src/jsonscanner.pp

@@ -50,7 +50,7 @@ type
 
   EScannerError       = class(EParserError);
 
-  TJSONOption = (joUTF8,joStrict,joComments);
+  TJSONOption = (joUTF8,joStrict,joComments,joIgnoreTrailingComma);
   TJSONOptions = set of TJSONOption;
 
 Const
@@ -353,6 +353,7 @@ begin
           end;
         end;
         SectionLength := TokenStr - TokenStart;
+        FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         If (FCurTokenString[1]='.') then
           FCurTokenString:='0'+FCurTokenString;
@@ -387,11 +388,14 @@ begin
       begin
       if Not (joComments in Options) then
         Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
+      TokenStart:=TokenStr;
       Inc(TokenStr);
       Case Tokenstr[0] of
         '/' : begin
               SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
-              SetString(FCurTokenString, TokenStart, SectionLength);
+              Inc(TokenStr);
+              FCurTokenString:='';
+              SetString(FCurTokenString, TokenStr, SectionLength);
               Fetchline;
               end;
         '*' :
@@ -403,8 +407,8 @@ begin
             if (TokenStr[0]=#0) then
               begin
               SectionLength := (TokenStr - TokenStart);
+              S:='';
               SetString(S, TokenStart, SectionLength);
-
               FCurtokenString:=FCurtokenString+S;
               if not fetchLine then
                 Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
@@ -417,6 +421,7 @@ begin
           if EOC then
             begin
             SectionLength := (TokenStr - TokenStart-1);
+            S:='';
             SetString(S, TokenStart, SectionLength);
             FCurtokenString:=FCurtokenString+S;
             Inc(TokenStr);
@@ -434,6 +439,7 @@ begin
           Inc(TokenStr);
         until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
         SectionLength := TokenStr - TokenStart;
+        FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
         for it := tkTrue to tkNull do
           if CompareText(CurTokenString, TokenInfos[it]) = 0 then

packages/fcl-json/tests/testjsonparser.pp

@@ -28,15 +28,20 @@ type
 
   TTestParser = class(TTestJSON)
   private
+    FOptions : TJSONOptions;
     procedure CallNoHandlerStream;
     procedure DoTestError(S: String);
     procedure DoTestFloat(F: TJSONFloat); overload;
     procedure DoTestFloat(F: TJSONFloat; S: String); overload;
     procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
     procedure DoTestString(S : String);
-    procedure DoTestArray(S: String; ACount: Integer; HaveComments : Boolean=False);
+    procedure DoTestArray(S: String; ACount: Integer; IgnoreJSON: Boolean=False);
     Procedure DoTestClass(S : String; AClass : TJSONDataClass);
     procedure CallNoHandler;
+    procedure DoTrailingCommaErrorArray;
+    procedure DoTrailingCommaErrorObject;
+  Protected
+    Procedure Setup; override;
   published
     procedure TestEmpty;
     procedure TestNull;
@@ -48,6 +53,9 @@ type
     procedure TestString;
     procedure TestArray;
     procedure TestObject;
+    procedure TestTrailingComma;
+    procedure TestTrailingCommaErrorArray;
+    procedure TestTrailingCommaErrorObject;
     procedure TestMixed;
     Procedure TestComment;
     procedure TestErrors;
@@ -206,7 +214,6 @@ procedure TTestParser.TestArray;
 Var
   S1,S2,S3 : String;
 
-
 begin
   DoTestArray('[]',0);
   DoTestArray('[null]',1);
@@ -224,9 +231,9 @@ begin
   Delete(S2,1,1);
   Str(34/10,S3);
   Delete(S3,1,1);
-  DoTestArray('['+S1+']',1);
-  DoTestArray('['+S1+', '+S2+']',2);
-  DoTestArray('['+S1+', '+S2+', '+S3+']',3);
+  DoTestArray('['+S1+']',1,true);
+  DoTestArray('['+S1+', '+S2+']',2,true);
+  DoTestArray('['+S1+', '+S2+', '+S3+']',3,true);
   DoTestArray('["A string"]',1);
   DoTestArray('["A string", "Another string"]',2);
   DoTestArray('["A string", "Another string", "Yet another string"]',3);
@@ -238,6 +245,33 @@ begin
   DoTestArray('[1, [1, 2]]',2);
 end;
 
+procedure TTestParser.TestTrailingComma;
+begin
+  FOptions:=[joIgnoreTrailingComma];
+  DoTestArray('[1, 2,]',2,True);
+  DoTestObject('{ "a" : 1, }',['a'],False);
+end;
+
+procedure TTestParser.TestTrailingCommaErrorArray;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorArray) ;
+end;
+
+procedure TTestParser.TestTrailingCommaErrorObject;
+begin
+  AssertException('Need joIgnoreTrailingComma in options to allow trailing comma',EJSONParser,@DoTrailingCommaErrorObject);
+end;
+
+procedure TTestParser.DoTrailingCommaErrorArray;
+begin
+  DoTestArray('[1, 2,]',2,True);
+end;
+
+procedure TTestParser.DoTrailingCommaErrorObject;
+begin
+  DoTestObject('{ "a" : 1, }',['a'],False);
+end;
+
 procedure TTestParser.TestMixed;
 
 Const
@@ -246,7 +280,7 @@ Const
          '  "address": {'+
          '      "street": "5 Main Street",'+LineEnding+
          '        "city": "San Diego, CA",'+LineEnding+
-         '        "zip": 91912,'+LineEnding+
+         '        "zip": 91912'+LineEnding+
          '    },'+LineEnding+
          '    "phoneNumbers": [  '+LineEnding+
          '        "619 332-3452",'+LineEnding+
@@ -266,6 +300,7 @@ end;
 
 procedure TTestParser.TestComment;
 begin
+  FOptions:=[joComments];
   DoTestArray('/* */ [1, {}]',2,True);
   DoTestArray('//'+sLineBreak+'[1, { "a" : 1 }]',2,True);
   DoTestArray('/* '+sLineBreak+' */ [1, {}]',2,True);
@@ -302,8 +337,10 @@ Var
   I : Integer;
 
 begin
+  J:=Nil;
   P:=TJSONParser.Create(S);
   Try
+    P.Options:=FOptions;
     J:=P.Parse;
     If (J=Nil) then
       Fail('Parse of object "'+S+'" fails');
@@ -322,21 +359,23 @@ begin
 end;
 
 
-procedure TTestParser.DoTestArray(S : String; ACount : Integer; HaveComments : Boolean = False);
+procedure TTestParser.DoTestArray(S : String; ACount : Integer; IgnoreJSON : Boolean = False);
 
 Var
   P : TJSONParser;
   J : TJSONData;
 
 begin
+  J:=Nil;
   P:=TJSONParser.Create(S,[joComments]);
   Try
+    P.Options:=FOptions;
     J:=P.Parse;
     If (J=Nil) then
       Fail('Parse of array "'+S+'" fails');
     TestJSONType(J,jtArray);
     TestItemCount(J,ACount);
-    if not HaveComments then
+    if not IgnoreJSON then
       TestJSON(J,S);
   Finally
     FreeAndNil(J);
@@ -403,6 +442,12 @@ begin
   GetJSON('1',True).Free;
 end;
 
+procedure TTestParser.Setup;
+begin
+  inherited Setup;
+  FOptions:=[];
+end;
+
 procedure TTestParser.CallNoHandlerStream;
 
 Var