paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #30606, identifier not allowed when parsing object

Browse Source 
git-svn-id: trunk@34536 -
This commit is contained in:
michael 2016-09-17 08:18:53 +00:00
parent a80e8f41c4
commit 5be2dfd9c8
2 changed files with 18 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-json/src/jsonparser.pp
View File

@ -148,6 +148,7 @@ begin
tkSQuaredBraceClose : DoError(SErrUnexpectedToken); tkSQuaredBraceClose : DoError(SErrUnexpectedToken);
tkNumber : Result:=ParseNumber; tkNumber : Result:=ParseNumber;
tkComma : DoError(SErrUnexpectedToken); tkComma : DoError(SErrUnexpectedToken);
tkIdentifier : DoError(SErrUnexpectedToken);
end; end;
except except
FreeAndNil(Result); FreeAndNil(Result);

24
packages/fcl-json/tests/testjsonparser.pp
View File

@ -22,6 +22,9 @@ uses
Classes, SysUtils, fpcunit, testutils, testregistry,fpjson, Classes, SysUtils, fpcunit, testutils, testregistry,fpjson,
jsonscanner,jsonParser,testjsondata; jsonscanner,jsonParser,testjsondata;
Const
DefaultOpts = [joUTF8,joStrict];
type type
{ TTestParser } { TTestParser }
@ -30,7 +33,7 @@ type
private private
FOptions : TJSONOptions; FOptions : TJSONOptions;
procedure CallNoHandlerStream; procedure CallNoHandlerStream;
procedure DoTestError(S: String); procedure DoTestError(S: String; Options : TJSONOptions = DefaultOpts);
procedure DoTestFloat(F: TJSONFloat); overload; procedure DoTestFloat(F: TJSONFloat); overload;
procedure DoTestFloat(F: TJSONFloat; S: String); overload; procedure DoTestFloat(F: TJSONFloat; S: String); overload;
procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True); procedure DoTestObject(S: String; const ElNames: array of String; DoJSONTest : Boolean = True);
@ -53,6 +56,7 @@ type
procedure TestString; procedure TestString;
procedure TestArray; procedure TestArray;
procedure TestObject; procedure TestObject;
procedure TestObjectError;
procedure TestTrailingComma; procedure TestTrailingComma;
procedure TestTrailingCommaErrorArray; procedure TestTrailingCommaErrorArray;
procedure TestTrailingCommaErrorObject; procedure TestTrailingCommaErrorObject;
@ -326,6 +330,12 @@ begin
DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']); DoTestObject('{ "a" : 1, "B" : { "c" : "d" } }',['a','B']);
end; end;
procedure TTestParser.TestObjectError;
begin
DoTestError('{ "name" : value }',[joUTF8]);
end;
procedure TTestParser.DoTestObject(S: String; const ElNames: array of String; procedure TTestParser.DoTestObject(S: String; const ElNames: array of String;
DoJSONTest: Boolean); DoJSONTest: Boolean);
@ -406,21 +416,21 @@ end;
procedure TTestParser.TestErrors; procedure TTestParser.TestErrors;
begin begin
{
DoTestError('a'); DoTestError('a');
DoTestError('"b'); DoTestError('"b');
DoTestError('1Tru'); DoTestError('1Tru');
}
DoTestError('b"'); DoTestError('b"');
DoTestError('{"a" : }'); DoTestError('{"a" : }');
DoTestError('{"a" : ""'); DoTestError('{"a" : ""');
DoTestError('{"a : ""'); DoTestError('{"a : ""');
{
DoTestError('[1,]'); DoTestError('[1,]');
DoTestError('[,]'); DoTestError('[,]');
DoTestError('[,,]'); DoTestError('[,,]');
DoTestError('[1,,]'); DoTestError('[1,,]');
}
end; end;
procedure TTestParser.TestClasses; procedure TTestParser.TestClasses;
@ -516,7 +526,7 @@ begin
end; end;
end; end;
procedure TTestParser.DoTestError(S : String); procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
Var Var
P : TJSONParser; P : TJSONParser;
@ -527,7 +537,7 @@ Var
begin begin
ParseOK:=False; ParseOK:=False;
P:=TJSONParser.Create(S); P:=TJSONParser.Create(S);
P.Strict:=True; P.OPtions:=Options;
J:=Nil; J:=Nil;
Try Try
Try Try