* Fix bug ID #37352

git-svn-id: trunk@45789 -

packages/fcl-json/src/jsonreader.pp

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

packages/fcl-json/src/jsonscanner.pp

@@ -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 = FEOL then
-        if FTokenStr[0] = #0 then
-          if not FetchLine 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);
+              Inc(FTokenStr);
-              Fetchline;
+              TokenStart:=FTokenStr;
+              SectionLength := PChar(FEOL)-TokenStart;
+              SetString(FCurTokenString, TokenStart, SectionLength);
+              FTokenStr:=FCurPos;
               end;
         '*' :
           begin

packages/fcl-json/tests/testjsonparser.pp

@@ -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