* Add support for parsing comments

git-svn-id: trunk@31292 -

packages/fcl-json/src/jsonparser.pp

@@ -28,12 +28,11 @@ Type
   TJSONParser = Class(TObject)
   Private
     FScanner : TJSONScanner;
-    FuseUTF8,
-    FStrict: Boolean;
+    function GetO(AIndex: TJSONOption): Boolean;
+    function GetOptions: TJSONOptions;
     function ParseNumber: TJSONNumber;
-    procedure SetStrict(const AValue: Boolean);
-    function GetUTF8 : Boolean;
-    procedure SetUTF8(const AValue: Boolean);
+    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
+    procedure SetOptions(AValue: TJSONOptions);
   Protected
     procedure DoError(const Msg: String);
     function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
@@ -45,13 +44,17 @@ Type
     Property Scanner : TJSONScanner read FScanner;
   Public
     function Parse: TJSONData;
-    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;
-    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;
+    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;deprecated 'use options form instead';
+    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
     destructor Destroy();override;
     // Use strict JSON: " for strings, object members are strings, not identifiers
-    Property Strict : Boolean Read FStrict Write SetStrict;
+    Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
     // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
-    Property UseUTF8 : Boolean Read GetUTF8 Write SetUTF8;
+    Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
+    // Parsing options
+    Property Options : TJSONOptions Read GetOptions Write SetOptions;
   end;
   
   EJSONParser = Class(EParserError);
@@ -87,7 +90,7 @@ begin
   end;
 end;
 
-Function TJSONParser.Parse : TJSONData;
+function TJSONParser.Parse: TJSONData;
 
 begin
   if (FScanner=Nil) then
@@ -102,22 +105,22 @@ end;
   If AllowEOF is false, encountering a tkEOF will result in an exception.
 }
 
-Function TJSONParser.CurrentToken : TJSONToken;
+function TJSONParser.CurrentToken: TJSONToken;
 
 begin
   Result:=FScanner.CurToken;
 end;
 
-Function TJSONParser.CurrentTokenString : String;
+function TJSONParser.CurrentTokenString: String;
 
 begin
-  If CurrentToken in [tkString,tkIdentifier,tkNumber] then
+  If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
     Result:=FScanner.CurTokenString
   else
     Result:=TokenInfos[CurrentToken];
 end;
 
-Function TJSONParser.DoParse(AtCurrent,AllowEOF : Boolean) : TJSONData;
+function TJSONParser.DoParse(AtCurrent, AllowEOF: Boolean): TJSONData;
 
 var
   T : TJSONToken;
@@ -151,7 +154,7 @@ end;
 
 
 // Creates the correct JSON number type, based on the current token.
-Function TJSONParser.ParseNumber : TJSONNumber;
+function TJSONParser.ParseNumber: TJSONNumber;
 
 Var
   I : Integer;
@@ -201,34 +204,32 @@ begin
 
 end;
 
-function TJSONParser.GetUTF8 : Boolean;
-
+function TJSONParser.GetO(AIndex: TJSONOption): Boolean;
 begin
-  if Assigned(FScanner) then
-    Result:=FScanner.UseUTF8
-  else
-    Result:=FUseUTF8;  
+  Result:=AIndex in Options;
 end;
 
-procedure TJSONParser.SetUTF8(const AValue: Boolean);
+function TJSONParser.GetOptions: TJSONOptions;
+begin
+  Result:=FScanner.Options
+end;
 
+procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean);
 begin
-  FUseUTF8:=AValue;
-  if Assigned(FScanner) then
-    FScanner.UseUTF8:=FUseUTF8;
+  if aValue then
+    FScanner.Options:=FScanner.Options+[AINdex]
+  else
+    FScanner.Options:=FScanner.Options-[AINdex]
 end;
 
-procedure TJSONParser.SetStrict(const AValue: Boolean);
+procedure TJSONParser.SetOptions(AValue: TJSONOptions);
 begin
-  if (FStrict=AValue) then
-     exit;
-  FStrict:=AValue;
-  If Assigned(FScanner) then
-    FScanner.Strict:=Fstrict;
+  FScanner.Options:=AValue;
 end;
 
+
 // Current token is {, on exit current token is }
-Function TJSONParser.ParseObject : TJSONObject;
+function TJSONParser.ParseObject: TJSONObject;
 
 Var
   T : TJSONtoken;
@@ -262,7 +263,7 @@ begin
 end;
 
 // Current token is [, on exit current token is ]
-Function TJSONParser.ParseArray : TJSONArray;
+function TJSONParser.ParseArray: TJSONArray;
 
 Var
   T : TJSONtoken;
@@ -297,15 +298,15 @@ begin
 end;
 
 // Get next token, discarding whitespace
-Function TJSONParser.GetNextToken : TJSONToken ;
+function TJSONParser.GetNextToken: TJSONToken;
 
 begin
   Repeat
     Result:=FScanner.FetchToken;
-  Until (Result<>tkWhiteSpace);
+  Until (Not (Result in [tkComment,tkWhiteSpace]));
 end;
 
-Procedure TJSONParser.DoError(const Msg : String);
+procedure TJSONParser.DoError(const Msg: String);
 
 Var
   S : String;
@@ -330,6 +331,16 @@ begin
   UseUTF8:=AUseUTF8;
 end;
 
+constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
+constructor TJSONParser.Create(const Source: String; AOptions: TJSONOptions);
+begin
+  FScanner:=TJSONScanner.Create(Source,AOptions);
+end;
+
 destructor TJSONParser.Destroy();
 begin
   FreeAndNil(FScanner);

packages/fcl-json/src/jsonscanner.pp

@@ -23,6 +23,7 @@ uses SysUtils, Classes;
 
 resourcestring
   SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
+  SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
   SErrOpenString = 'string exceeds end of line';
 
 type
@@ -43,32 +44,44 @@ type
     tkSquaredBraceOpen,       // '['
     tkSquaredBraceClose,      // ']'
     tkIdentifier,            // Any Javascript identifier
+    tkComment,
     tkUnknown
     );
 
   EScannerError       = class(EParserError);
 
+  TJSONOption = (joUTF8,joStrict,joComments);
+  TJSONOptions = set of TJSONOption;
+
+Const
+  DefaultOptions = [joUTF8];
+
+Type
 
   { TJSONScanner }
 
   TJSONScanner = class
   private
+    FAllowComments: Boolean;
     FSource : TStringList;
     FCurRow: Integer;
     FCurToken: TJSONToken;
     FCurTokenString: string;
     FCurLine: string;
-    FStrict: Boolean;
-    FUseUTF8 : Boolean;
     TokenStr: PChar;
+    FOptions : TJSONOptions;
     function GetCurColumn: Integer;
+    function GetO(AIndex: TJSONOption): Boolean;
+    procedure SetO(AIndex: TJSONOption; AValue: Boolean);
   protected
     procedure Error(const Msg: string);overload;
     procedure Error(const Msg: string; Const Args: array of Const);overload;
     function DoFetchToken: TJSONToken;
   public
-    constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;
-    constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload;
+    constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload; deprecated 'use options form instead';
+    constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload; deprecated  'use options form instead';
+    constructor Create(Source: TStream; AOptions: TJSONOptions); overload;
+    constructor Create(const Source: String; AOptions: TJSONOptions); overload;
     destructor Destroy; override;
     function FetchToken: TJSONToken;
 
@@ -80,9 +93,11 @@ type
     property CurToken: TJSONToken read FCurToken;
     property CurTokenString: string read FCurTokenString;
     // Use strict JSON: " for strings, object members are strings, not identifiers
-    Property Strict : Boolean Read FStrict Write FStrict;
+    Property Strict : Boolean Index joStrict Read GetO Write SetO ; deprecated 'use options instead';
     // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
-    Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
+    Property UseUTF8 : Boolean index joUTF8 Read GetO Write SetO; deprecated 'Use options instead';
+    // Parsing options
+    Property Options : TJSONOptions Read FOptions Write FOptions;
   end;
 
 const
@@ -101,6 +116,7 @@ const
     '[',
     ']',
     'identifier',
+    'comment',
     ''
   );
 
@@ -109,17 +125,43 @@ implementation
 
 constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
 
+Var
+  O : TJSONOptions;
+
+begin
+  O:=DefaultOptions;
+  if AUseUTF8 then
+    Include(O,joUTF8)
+  else
+    Exclude(O,joUTF8);
+  Create(Source,O);
+end;
+
+constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
+Var
+  O : TJSONOptions;
+
+begin
+  O:=DefaultOptions;
+  if AUseUTF8 then
+    Include(O,joUTF8)
+  else
+    Exclude(O,joUTF8);
+  Create(Source,O);
+end;
+
+constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
 begin
   FSource:=TStringList.Create;
   FSource.LoadFromStream(Source);
-  FUseUTF8:=AUseUTF8;
+  FOptions:=AOptions;
 end;
 
-constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
+constructor TJSONScanner.Create(const Source: String; AOptions: TJSONOptions);
 begin
   FSource:=TStringList.Create;
   FSource.Text:=Source;
-  FUseUTF8:=AUseUTF8;
+  FOptions:=AOptions;
 end;
 
 destructor TJSONScanner.Destroy;
@@ -140,7 +182,7 @@ begin
   raise EScannerError.Create(Msg);
 end;
 
-procedure TJSONScanner.Error(const Msg: string; const Args: array of Const);
+procedure TJSONScanner.Error(const Msg: string; const Args: array of const);
 begin
   raise EScannerError.CreateFmt(Msg, Args);
 end;
@@ -170,7 +212,8 @@ var
   OldLength, SectionLength, Index: Integer;
   C : char;
   S : String;
-  
+  IsStar,EOC: Boolean;
+
 begin
   if TokenStr = nil then
     if not FetchLine then
@@ -342,6 +385,55 @@ begin
         Inc(TokenStr);
         Result := tkSquaredBraceClose;
       end;
+    '/' :
+      begin
+      if Not (joComments in Options) then
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
+      Inc(TokenStr);
+      Case Tokenstr[0] of
+        '/' : begin
+              SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
+              SetLength(FCurTokenString,SectionLength);
+              if SectionLength > 0 then
+                Move(TokenStart^, FCurTokenString[1], SectionLength);
+              Fetchline;
+              end;
+        '*' :
+          begin
+          IsStar:=False;
+          Inc(TokenStr);
+          TokenStart:=TokenStr;
+          Repeat
+            if (TokenStr[0]=#0) then
+              begin
+              SectionLength := (TokenStr - TokenStart);
+              SetLength(S,SectionLength);
+              if SectionLength > 0 then
+                Move(TokenStart^, S[1], SectionLength);
+              FCurtokenString:=FCurtokenString+S;
+              if not fetchLine then
+                Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
+              TokenStart:=TokenStr;
+              end;
+            IsStar:=TokenStr[0]='*';
+            Inc(TokenStr);
+            EOC:=(isStar and (TokenStr[0]='/'));
+          Until EOC;
+          if EOC then
+            begin
+            SectionLength := (TokenStr - TokenStart-1);
+            SetLength(S,SectionLength);
+            if SectionLength > 0 then
+              Move(TokenStart^, S[1], SectionLength);
+            FCurtokenString:=FCurtokenString+S;
+            Inc(TokenStr);
+            end;
+          end;
+      else
+        Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
+      end;
+      Result:=tkComment;
+      end;
     'a'..'z','A'..'Z','_':
       begin
         TokenStart := TokenStr;
@@ -376,4 +468,17 @@ begin
   Result := TokenStr - PChar(CurLine);
 end;
 
+function TJSONScanner.GetO(AIndex: TJSONOption): Boolean;
+begin
+  Result:=AIndex in FOptions;
+end;
+
+procedure TJSONScanner.SetO(AIndex: TJSONOption; AValue: Boolean);
+begin
+  If AValue then
+    Include(Foptions,AIndex)
+  else
+    Exclude(Foptions,AIndex)
+end;
+
 end.

packages/fcl-json/tests/testjson.lpi

@@ -24,48 +24,35 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
+        <CommandLineParams Value="--suite=TTestParser.TestComment"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="4">
+    <RequiredPackages Count="1">
       <Item1>
-        <PackageName Value="fpcunitconsolerunner"/>
-      </Item1>
-      <Item2>
-        <PackageName Value="LCL"/>
-      </Item2>
-      <Item3>
-        <PackageName Value="FPCUnitTestRunner"/>
-      </Item3>
-      <Item4>
         <PackageName Value="FCL"/>
-      </Item4>
+      </Item1>
     </RequiredPackages>
     <Units Count="5">
       <Unit0>
         <Filename Value="testjson.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjson"/>
       </Unit0>
       <Unit1>
         <Filename Value="testjsonparser.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjsonparser"/>
       </Unit1>
       <Unit2>
         <Filename Value="testjsondata.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjsondata"/>
       </Unit2>
       <Unit3>
         <Filename Value="testjsonrtti.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjsonrtti"/>
       </Unit3>
       <Unit4>
         <Filename Value="../src/fpjsonrtti.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fpjsonrtti"/>
       </Unit4>
     </Units>
   </ProjectOptions>
@@ -79,12 +66,6 @@
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
     </Parsing>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">

packages/fcl-json/tests/testjsonconf.lpi

@@ -1,16 +1,20 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="5"/>
+    <Version Value="9"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <TargetFileExt Value=""/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -23,24 +27,19 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="1">
       <Item1>
-        <PackageName Value="FPCUnitConsoleRunner"/>
-      </Item1>
-      <Item2>
         <PackageName Value="FCL"/>
-      </Item2>
+      </Item1>
     </RequiredPackages>
     <Units Count="3">
       <Unit0>
         <Filename Value="testjsonconf.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="testjsonconf"/>
       </Unit0>
       <Unit1>
         <Filename Value="jsonconftest.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="jsonconftest"/>
       </Unit1>
       <Unit2>
         <Filename Value="../src/jsonconf.pp"/>
@@ -50,15 +49,14 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
+    <Version Value="11"/>
     <SearchPaths>
-      <OtherUnitFiles Value="../src/"/>
+      <OtherUnitFiles Value="../src"/>
     </SearchPaths>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
   </CompilerOptions>
 </CONFIG>

packages/fcl-json/tests/testjsonparser.pp

@@ -20,7 +20,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testutils, testregistry,fpjson,
-  jsonParser,testjsondata;
+  jsonscanner,jsonParser,testjsondata;
 
 type
 
@@ -34,7 +34,7 @@ type
     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);
+    procedure DoTestArray(S: String; ACount: Integer; HaveComments : Boolean=False);
     Procedure DoTestClass(S : String; AClass : TJSONDataClass);
     procedure CallNoHandler;
   published
@@ -49,6 +49,7 @@ type
     procedure TestArray;
     procedure TestObject;
     procedure TestMixed;
+    Procedure TestComment;
     procedure TestErrors;
     Procedure TestClasses;
     Procedure TestHandler;
@@ -263,6 +264,24 @@ begin
   DoTestObject(SAddr,['addressbook'],False);
 end;
 
+procedure TTestParser.TestComment;
+begin
+  DoTestArray('/* */ [1, {}]',2,True);
+  DoTestArray('//'+sLineBreak+'[1, { "a" : 1 }]',2,True);
+  DoTestArray('/* '+sLineBreak+' */ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/*'+sLineBreak+'*'+sLineBreak+'*/ [1, {}]',2,True);
+  DoTestArray('/**'+sLineBreak+'**'+sLineBreak+'**/ [1, {}]',2,True);
+  DoTestArray('/* */ [1, {}]',2,True);
+  DoTestArray('[1, { "a" : 1 }]//'+sLineBreak,2,True);
+  DoTestArray('[1, {}]/* '+sLineBreak+' */ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*/ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*/ ',2,True);
+  DoTestArray('[1, {}]/*'+sLineBreak+'*'+sLineBreak+'*/ ',2,True);
+  DoTestArray(' [1, {}]/**'+sLineBreak+'**'+sLineBreak+'**/',2,True);
+end;
+
 procedure TTestParser.TestObject;
 begin
   DoTestObject('{}',[]);
@@ -303,21 +322,22 @@ begin
 end;
 
 
-procedure TTestParser.DoTestArray(S : String; ACount : Integer);
+procedure TTestParser.DoTestArray(S : String; ACount : Integer; HaveComments : Boolean = False);
 
 Var
   P : TJSONParser;
   J : TJSONData;
 
 begin
-  P:=TJSONParser.Create(S);
+  P:=TJSONParser.Create(S,[joComments]);
   Try
     J:=P.Parse;
     If (J=Nil) then
       Fail('Parse of array "'+S+'" fails');
     TestJSONType(J,jtArray);
     TestItemCount(J,ACount);
-    TestJSON(J,S);
+    if not HaveComments then
+      TestJSON(J,S);
   Finally
     FreeAndNil(J);
     FreeAndNil(P);