From 073b9921225e55f9c7e1b0fffcbed086296d5ee9 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sat, 1 May 2021 16:15:42 +0000
Subject: [PATCH] * Merging revisions 47005 from trunk:    
 ------------------------------------------------------------------------    
 r47005 | michael | 2020-09-29 17:33:59 +0200 (Tue, 29 Sep 2020) | 1 line

    * Fix more strict handling of numbers (bug ID 37840, patch by Benito van der Zander)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@49317 -
---
 packages/fcl-json/src/jsonscanner.pp      | 51 +++++++++++++++--------
 packages/fcl-json/tests/testjsonreader.pp | 11 +++++
 2 files changed, 45 insertions(+), 17 deletions(-)

diff --git a/packages/fcl-json/src/jsonscanner.pp b/packages/fcl-json/src/jsonscanner.pp
index 8f74ed130c..99b732ec1f 100644
--- a/packages/fcl-json/src/jsonscanner.pp
+++ b/packages/fcl-json/src/jsonscanner.pp
@@ -412,37 +412,54 @@ begin
     '0'..'9','.','-':
       begin
         TokenStart := FTokenStr;
+        if FTokenStr^ = '-' then inc(FTokenStr);
+        case FTokenStr^ of
+          '1'..'9': Inc(FTokenStr);
+          '0': begin
+            Inc(FTokenStr);
+            if (joStrict in Options) and (FTokenStr^ in ['0'..'9']) then
+              Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          end;
+          '.': if joStrict in Options then
+                 Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          else
+            Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+        end;
         while true do
         begin
-          Inc(FTokenStr);
           case FTokenStr^ of
+            '0'..'9': inc(FTokenStr);
             '.':
               begin
-                if FTokenStr[1] in ['0'..'9', 'e', 'E'] then
-                begin
-                  Inc(FTokenStr);
-                  repeat
+                case FTokenStr[1] of
+                  '0'..'9': Inc(FTokenStr, 2);
+                  'e', 'E': begin
+                    if joStrict in Options then
+                      Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                     Inc(FTokenStr);
-                  until not (FTokenStr^ in ['0'..'9', 'e', 'E','-','+']);
+                  end;
+                  else Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                 end;
-                break;
-              end;
-            '0'..'9': ;
-            'e', 'E':
-              begin
-                Inc(FTokenStr);
-                if FTokenStr^ in ['-','+']  then
-                  Inc(FTokenStr);
                 while FTokenStr^ in ['0'..'9'] do
-                  Inc(FTokenStr);
+                  inc(FTokenStr);
                 break;
               end;
           else
-            if {(FTokenStr<>FEOL) and }not (FTokenStr^ in [#13,#10,#0,'}',']',',',#9,' ']) then
-               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             break;
           end;
         end;
+        if FTokenStr^ in ['e', 'E'] then begin
+          Inc(FTokenStr);
+          if FTokenStr^ in ['-','+']  then
+            Inc(FTokenStr);
+          if not (FTokenStr^ in ['0'..'9']) then
+            Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
+          repeat
+            Inc(FTokenStr);
+          until not (FTokenStr^ in ['0'..'9']);
+        end;
+        if {(FTokenStr<>FEOL) and }not (FTokenStr^ in [#13,#10,#0,'}',']',',',#9,' ']) then
+          Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
         SectionLength := FTokenStr - TokenStart;
         FCurTokenString:='';
         SetString(FCurTokenString, TokenStart, SectionLength);
diff --git a/packages/fcl-json/tests/testjsonreader.pp b/packages/fcl-json/tests/testjsonreader.pp
index 180f4ef2f6..132dbf4fe0 100644
--- a/packages/fcl-json/tests/testjsonreader.pp
+++ b/packages/fcl-json/tests/testjsonreader.pp
@@ -42,6 +42,8 @@ type
 
   { TTestReader }
 
+  { TBaseTestReader }
+
   TBaseTestReader = class(TTestJSON)
   private
     FOptions : TJSONOptions;
@@ -60,6 +62,7 @@ type
     procedure TestTrue;
     procedure TestFalse;
     procedure TestFloat;
+    procedure TestFloatError;
     procedure TestInteger;
     procedure TestInt64;
     procedure TestString;
@@ -299,6 +302,14 @@ begin
   DoTestFloat(0,'0.0');
 end;
 
+procedure TBaseTestReader.TestFloatError;
+begin
+  DoTestError('.12',[joStrict]);
+  DoTestError('.12E',[]);
+  DoTestError('0.12E+',[]);
+  DoTestError('.12E+-1',[]);
+end;
+
 procedure TBaseTestReader.TestString;
 
 begin