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);