diff --git a/packages/fcl-json/src/jsonparser.pp b/packages/fcl-json/src/jsonparser.pp index 3470749c12..886982b10c 100644 --- a/packages/fcl-json/src/jsonparser.pp +++ b/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 + Result:=AIndex in Options; +end; + +function TJSONParser.GetOptions: TJSONOptions; +begin + Result:=FScanner.Options +end; + +procedure TJSONParser.SetO(AIndex: TJSONOption; AValue: Boolean); +begin + if aValue then + FScanner.Options:=FScanner.Options+[AINdex] else - Result:=FUseUTF8; + FScanner.Options:=FScanner.Options-[AINdex] end; -procedure TJSONParser.SetUTF8(const AValue: Boolean); - +procedure TJSONParser.SetOptions(AValue: TJSONOptions); begin - FUseUTF8:=AValue; - if Assigned(FScanner) then - FScanner.UseUTF8:=FUseUTF8; + FScanner.Options:=AValue; end; -procedure TJSONParser.SetStrict(const AValue: Boolean); -begin - if (FStrict=AValue) then - exit; - FStrict:=AValue; - If Assigned(FScanner) then - FScanner.Strict:=Fstrict; -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); diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp index 4bde174618..142eca3cdc 100644 --- a/packages/fcl-json/src/jsonscanner.pp +++ b/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 - FSource:=TStringList.Create; - FSource.LoadFromStream(Source); - FUseUTF8:=AUseUTF8; + 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); + FOptions:=AOptions; +end; + +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. diff --git a/packages/fcl-json/tests/testjson.lpi b/packages/fcl-json/tests/testjson.lpi index 36137f6e60..fb98069062 100644 --- a/packages/fcl-json/tests/testjson.lpi +++ b/packages/fcl-json/tests/testjson.lpi @@ -24,48 +24,35 @@ + - + - - - - - - - - - - + - - - - - @@ -79,12 +66,6 @@ - - - - - - diff --git a/packages/fcl-json/tests/testjsonconf.lpi b/packages/fcl-json/tests/testjsonconf.lpi index 113c752c53..1d7863fdd2 100644 --- a/packages/fcl-json/tests/testjsonconf.lpi +++ b/packages/fcl-json/tests/testjsonconf.lpi @@ -1,16 +1,20 @@ - + - - + + + + - - + + + + @@ -23,24 +27,19 @@ - + - - - - + - - @@ -50,15 +49,14 @@ - + - + - - - - - - + + + + + diff --git a/packages/fcl-json/tests/testjsonparser.pp b/packages/fcl-json/tests/testjsonparser.pp index 6e64f9fe0c..4f9e16af4a 100644 --- a/packages/fcl-json/tests/testjsonparser.pp +++ b/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);