mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 02:48:07 +02:00
* Merging revisions r45789 from trunk:
------------------------------------------------------------------------ r45789 | michael | 2020-07-15 11:23:24 +0200 (Wed, 15 Jul 2020) | 1 line * Fix bug ID #37352 ------------------------------------------------------------------------ git-svn-id: branches/fixes_3_2@46629 -
This commit is contained in:
parent
ed3f8f66f1
commit
2bda5dd2e4
@ -331,6 +331,7 @@ Procedure TBaseJSONReader.ParseObject;
|
||||
Var
|
||||
T : TJSONtoken;
|
||||
LastComma : Boolean;
|
||||
S : TJSONStringType;
|
||||
|
||||
begin
|
||||
LastComma:=False;
|
||||
@ -340,7 +341,9 @@ begin
|
||||
begin
|
||||
If (T<>tkString) and (T<>tkIdentifier) then
|
||||
DoError(SErrExpectedElementName);
|
||||
KeyValue(CurrentTokenString);
|
||||
S:=CurrentTokenString;
|
||||
KeyValue(S);
|
||||
// Writeln(S);
|
||||
T:=GetNextToken;
|
||||
If (T<>tkColon) then
|
||||
DoError(SErrExpectedColon);
|
||||
|
@ -190,7 +190,16 @@ end;
|
||||
|
||||
function TJSONScanner.FetchToken: TJSONToken;
|
||||
|
||||
(*
|
||||
procedure dumpcurrent;
|
||||
|
||||
begin
|
||||
Writeln('Start of line : ',FCurLine);
|
||||
Writeln('Cur pos : ',FCurPos);
|
||||
Writeln('Start of token : ',FTokenstr);
|
||||
Writeln('End of line : ',FTokenstr);
|
||||
end;
|
||||
*)
|
||||
function FetchLine: Boolean;
|
||||
|
||||
|
||||
@ -203,7 +212,7 @@ function TJSONScanner.FetchToken: TJSONToken;
|
||||
While Not (FCurPos^ in [#0,#10,#13]) do
|
||||
Inc(FCurPos);
|
||||
FEOL:=FCurPos;
|
||||
if (FCurPos^<>#0) then
|
||||
While (FCurPos^<>#0) and (FCurPos^ in [#10,#13]) do
|
||||
begin
|
||||
if (FCurPos^=#13) and (FCurPos[1]=#10) then
|
||||
Inc(FCurPos); // Skip CR-LF
|
||||
@ -211,7 +220,7 @@ function TJSONScanner.FetchToken: TJSONToken;
|
||||
Inc(FCurRow); // Increase line index
|
||||
end;
|
||||
// Len:=FEOL-FTokenStr;
|
||||
// FTokenStr:=PAnsiChar(FCurLine);
|
||||
// FTokenStr:=FCurPos;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -251,13 +260,14 @@ var
|
||||
|
||||
begin
|
||||
if (FTokenStr = nil) or (FTokenStr=FEOL) then
|
||||
begin
|
||||
if not FetchLine then
|
||||
begin
|
||||
Result := tkEOF;
|
||||
FCurToken := Result;
|
||||
exit;
|
||||
end;
|
||||
|
||||
end;
|
||||
FCurTokenString := '';
|
||||
case FTokenStr^ of
|
||||
#0: // Empty line
|
||||
@ -269,13 +279,16 @@ begin
|
||||
begin
|
||||
Result := tkWhitespace;
|
||||
repeat
|
||||
Inc(FTokenStr);
|
||||
if FTokenStr[0] = #0 then
|
||||
if not FetchLine then
|
||||
if FTokenStr = FEOL then
|
||||
begin
|
||||
if not FetchLine then
|
||||
begin
|
||||
FCurToken := Result;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
end
|
||||
else
|
||||
Inc(FTokenStr);
|
||||
until not (FTokenStr[0] in [#9, ' ']);
|
||||
end;
|
||||
'"','''':
|
||||
@ -453,11 +466,12 @@ begin
|
||||
Inc(FTokenStr);
|
||||
Case FTokenStr^ of
|
||||
'/' : begin
|
||||
SectionLength := Length(FCurLine)- (FTokenStr - PChar(FCurLine));
|
||||
Inc(FTokenStr);
|
||||
FCurTokenString:='';
|
||||
SetString(FCurTokenString, FTokenStr, SectionLength);
|
||||
Fetchline;
|
||||
Inc(FTokenStr);
|
||||
TokenStart:=FTokenStr;
|
||||
SectionLength := PChar(FEOL)-TokenStart;
|
||||
SetString(FCurTokenString, TokenStart, SectionLength);
|
||||
FTokenStr:=FCurPos;
|
||||
end;
|
||||
'*' :
|
||||
begin
|
||||
|
@ -70,6 +70,9 @@ type
|
||||
Procedure TestHandlerResult;
|
||||
Procedure TestHandlerResultStream;
|
||||
Procedure TestEmptyLine;
|
||||
Procedure TestStartEmptyLine;
|
||||
Procedure TestObjectEmptyLine;
|
||||
Procedure TestCommentLine;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -564,6 +567,90 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TestStartEmptyLine;
|
||||
|
||||
// Bug ID 37352: case 1
|
||||
|
||||
const
|
||||
ENDLINE = #$0d#$0a;
|
||||
|
||||
Const
|
||||
MyJSON = ENDLINE+
|
||||
'{'+ENDLINE+
|
||||
'"version":100,'+ENDLINE+
|
||||
// '//comment'+ENDLINE+
|
||||
'"value":200'+ENDLINE+
|
||||
'}'+ENDLINE;
|
||||
|
||||
var
|
||||
J : TJSONData;
|
||||
|
||||
begin
|
||||
With TJSONParser.Create(MyJSON,[joComments]) do
|
||||
Try
|
||||
J:=Parse;
|
||||
J.Free;
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TestObjectEmptyLine;
|
||||
|
||||
// Bug ID 37352: case 2
|
||||
|
||||
const
|
||||
ENDLINE = #$0d#$0a;
|
||||
|
||||
|
||||
Const
|
||||
MyJSON = '{'+ENDLINE+
|
||||
''+ENDLINE+
|
||||
'"version":100, //comment'+ENDLINE+
|
||||
'"value":200'+ENDLINE+
|
||||
'}'+ENDLINE;
|
||||
var
|
||||
J : TJSONData;
|
||||
|
||||
begin
|
||||
With TJSONParser.Create(MyJSON,[joComments]) do
|
||||
Try
|
||||
J:=Parse;
|
||||
J.Free;
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.TestCommentLine;
|
||||
|
||||
// Bug ID 37352: case 3
|
||||
|
||||
const
|
||||
ENDLINE = #$0d#$0a;
|
||||
|
||||
|
||||
Const
|
||||
MyJSON =
|
||||
ENDLINE+
|
||||
'{'+ENDLINE+
|
||||
'"version":100, //comment'+ENDLINE+
|
||||
'"value":200'+ENDLINE+
|
||||
'}'+ENDLINE;
|
||||
|
||||
var
|
||||
J : TJSONData;
|
||||
|
||||
begin
|
||||
With TJSONParser.Create(MyJSON,[joComments]) do
|
||||
Try
|
||||
J:=Parse;
|
||||
J.Free;
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
|
||||
|
||||
Var
|
||||
|
Loading…
Reference in New Issue
Block a user