View Issue Details

IDProjectCategoryView StatusLast Update
0035113FPCFCLpublic2019-02-25 22:04
ReporterAlexey Tor.Assigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformWin10, Win7 x64OSOS Version
Product Version3.3.1Product Build 
Target Version3.2.0Fixed in Version3.3.1 
Summary0035113: JsonConf handles Unicode path/value wrong on Win32
DescriptionI tested on last FPC trunk fpJson version.
On each reading/writing a Unicode json path/value, I see corrupted enc in resulting json file.

Demo app writes file t.json in its folder. Each button press makes file bad.
TagsNo tags attached.
Fixed in Revision41473
FPCOldBugId
FPCTarget
Attached Files
  • tst-json-enc-bug.zip (3,104 bytes)
  • fpjson.pp-35113.patch (1,383 bytes)
    Index: packages/fcl-json/src/fpjson.pp
    ===================================================================
    --- packages/fcl-json/src/fpjson.pp	(revision 41455)
    +++ packages/fcl-json/src/fpjson.pp	(working copy)
    @@ -2496,7 +2496,7 @@
           vtChar       : Result:=CreateJSON(VChar);
           vtExtended   : Result:=CreateJSON(VExtended^);
           vtString     : Result:=CreateJSON(vString^);
    -      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
    +      vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
           vtPChar      : Result:=CreateJSON(StrPas(VPChar));
           vtPointer    : If (VPointer<>Nil) then
                            TJSONData.DoError(SErrPointerNotNil,[SourceType])
    @@ -3153,7 +3153,7 @@
     
     Var
       I : integer;
    -  AName : String;
    +  AName : TJSONUnicodeStringType;
       J : TJSONData;
     
     begin
    @@ -3173,7 +3173,7 @@
           Case VType of
             vtChar       : AName:=VChar;
             vtString     : AName:=vString^;
    -        vtAnsiString : AName:=(AnsiString(vAnsiString));
    +        vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
             vtPChar      : AName:=StrPas(VPChar);
           else
             DoError(SErrNameMustBeString,[I+1]);
    @@ -3183,7 +3183,7 @@
           DoError(SErrNameMustBeString,[I+1]);
         Inc(I);
         J:=VarRecToJSON(Elements[i],'Object');
    -    Add(AName,J);
    +    Add(UTF8Encode(AName),J);
         Inc(I);
         end;
     end;
    
    fpjson.pp-35113.patch (1,383 bytes)
  • jsonconf-35113.patch (4,810 bytes)
    Index: packages/fcl-json/src/fpjson.pp
    ===================================================================
    --- packages/fcl-json/src/fpjson.pp	(revision 41455)
    +++ packages/fcl-json/src/fpjson.pp	(working copy)
    @@ -2496,7 +2496,7 @@
           vtChar       : Result:=CreateJSON(VChar);
           vtExtended   : Result:=CreateJSON(VExtended^);
           vtString     : Result:=CreateJSON(vString^);
    -      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
    +      vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
           vtPChar      : Result:=CreateJSON(StrPas(VPChar));
           vtPointer    : If (VPointer<>Nil) then
                            TJSONData.DoError(SErrPointerNotNil,[SourceType])
    @@ -3153,7 +3153,7 @@
     
     Var
       I : integer;
    -  AName : String;
    +  AName : TJSONUnicodeStringType;
       J : TJSONData;
     
     begin
    @@ -3173,7 +3173,7 @@
           Case VType of
             vtChar       : AName:=VChar;
             vtString     : AName:=vString^;
    -        vtAnsiString : AName:=(AnsiString(vAnsiString));
    +        vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
             vtPChar      : AName:=StrPas(VPChar);
           else
             DoError(SErrNameMustBeString,[I+1]);
    @@ -3183,7 +3183,7 @@
           DoError(SErrNameMustBeString,[I+1]);
         Inc(I);
         J:=VarRecToJSON(Elements[i],'Object');
    -    Add(AName,J);
    +    Add(UTF8Encode(AName),J);
         Inc(I);
         end;
     end;
    Index: packages/fcl-json/src/jsonconf.pp
    ===================================================================
    --- packages/fcl-json/src/jsonconf.pp	(revision 41455)
    +++ packages/fcl-json/src/jsonconf.pp	(working copy)
    @@ -97,6 +97,7 @@
         Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
         Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
         procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
    +    procedure SetValue(const APath: RawByteString; const AValue: RawByteString); overload;
         procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
         procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
         procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
    @@ -418,6 +419,12 @@
       FModified:=True;
     end;
     
    +procedure TJSONConfig.SetValue(const APath: RawByteString;
    +  const AValue: RawByteString);
    +begin
    +  SetValue(UTF8Decode(APath),UTF8Decode(AValue));
    +end;
    +
     procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
     begin
       if AValue = DefValue then
    Index: packages/fcl-json/src/jsonreader.pp
    ===================================================================
    --- packages/fcl-json/src/jsonreader.pp	(revision 41455)
    +++ packages/fcl-json/src/jsonreader.pp	(working copy)
    @@ -36,7 +36,7 @@
         procedure DoError(const Msg: String);
         Procedure DoParse(AtCurrent,AllowEOF: Boolean);
         function GetNextToken: TJSONToken;
    -    function CurrentTokenString: String;
    +    function CurrentTokenString: RawByteString;
         function CurrentToken: TJSONToken; inline;
     
         Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
    @@ -203,7 +203,7 @@
       Result:=FScanner.CurToken;
     end;
     
    -function TBaseJSONReader.CurrentTokenString: String;
    +function TBaseJSONReader.CurrentTokenString: RawByteString;
     
     begin
       If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
    Index: packages/fcl-json/src/jsonscanner.pp
    ===================================================================
    --- packages/fcl-json/src/jsonscanner.pp	(revision 41455)
    +++ packages/fcl-json/src/jsonscanner.pp	(working copy)
    @@ -28,7 +28,7 @@
     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';
    +  SErrOpenString = 'string exceeds end of line %d';
     
     type
     
    @@ -331,7 +331,7 @@
                           u1:=u2;
                           end
                         end;
    -              #0  : Error(SErrOpenString);
    +              #0  : Error(SErrOpenString,[FCurRow]);
                 else
                   Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
                 end;
    @@ -355,11 +355,11 @@
               else
                 MaybeAppendUnicode;
               if FTokenStr[0] = #0 then
    -            Error(SErrOpenString);
    +            Error(SErrOpenString,[FCurRow]);
               Inc(FTokenStr);
               end;
             if FTokenStr[0] = #0 then
    -          Error(SErrOpenString);
    +          Error(SErrOpenString,[FCurRow]);
             MaybeAppendUnicode;
             SectionLength := FTokenStr - TokenStart;
             SetLength(FCurTokenString, OldLength + SectionLength);
    
    jsonconf-35113.patch (4,810 bytes)

Activities

Alexey Tor.

2019-02-18 17:33

reporter  

tst-json-enc-bug.zip (3,104 bytes)

Alexey Tor.

2019-02-18 17:34

reporter   ~0114241

Expected t.json content: key/value with russian text.
Reality: broken encoding in key/value.

Alexey Tor.

2019-02-19 22:43

reporter   ~0114273

I found that function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;
must be improved.
Now it gets UTF8string and CANNOT ESCAPE unicode at all.
And it don't check for code>255.

Michael Van Canneyt

2019-02-19 23:34

administrator   ~0114276

StringToJSONString does not need to escape anything.

A JSON string can contain unicode characters.
When parsing JSON, you need to unescape \uNNNN escapes, but when writing JSON there is no need to write \uNNNN.

Of course, the input string must be UTF8. That is why TJSONStringType is UTF8String.

Alexey Tor.

2019-02-20 09:48

reporter   ~0114286

Ok, let the function be the same.
What about %subj% bugreport?

Michael Van Canneyt

2019-02-20 09:51

administrator   ~0114287

I will look at the bugreport during the weekend. I don't use Windows, so this requires me to boot a windows VM etc. It takes time.

Alexey Tor.

2019-02-20 12:41

reporter   ~0114291

Last edited: 2019-02-20 12:43

View 3 revisions

I used this fix (for me it's ok, i know func is now a little slower)
It always escapes char code >255.
<code>
function StringToJSONString(const S: TJSONStringType; Strict : Boolean = False): TJSONStringType;

Var
  I : Integer;
  C : WideChar;
  SW : UnicodeString;

begin
  Result:='';
  SW:=UTF8Decode(S);
  for I:=1 to Length(SW) do
  begin
    C:=SW[I];
    if Ord(C)>255 then
      Result:=Result+'\u'+HexStr(Ord(C),4)
    else
    case C of
      '\' : Result:=Result+'\\';
      '/' : if Strict then
              Result:=Result+'\/'
            else
              Result:=Result+'/';
      '"' : Result:=Result+'\"';
      0000008 : Result:=Result+'\b';
      0000009 : Result:=Result+'\t';
      0000010 : Result:=Result+'\n';
      0000012 : Result:=Result+'\f';
      0000013 : Result:=Result+'\r';
      else
        begin
          if Ord(C)<32 then
            Result:=Result+'\u'+HexStr(Ord(C),4)
          else
            Result:=Result+Char(C);
        end;
    end;
  end;
end;
</code>

Michael Van Canneyt

2019-02-20 13:15

administrator   ~0114293

Last edited: 2019-02-20 13:15

View 2 revisions

This means that your input string is not proper UTF8 ?

Michael Van Canneyt

2019-02-20 13:51

administrator   ~0114295

The problem is not in StringToJSONString. if you add this to Button1.Click:

  A:=TJSONObject.Create(['проверка фигни', 'фигня']);
  try
    Memo1.Lines.Text:=A.AsJSON;
  finally
    A.Free;
  end;

You get

{ "проверка фигни" : "фигня" }

Which is expected, and it means that asJSON by itself returns correct data.

Furthermore, if I change your code to

c.SetValue(Utf8Decode('/проверка фигни'), Utf8Decode('фигня'));

it works as expected. The file is then also correct.

Alexey Tor.

2019-02-20 13:59

reporter   ~0114296

I see broken file after 2-3 button presses in demo.
After 1st press - file is ok.
After 2nd-3rd - file is broken and Memo shows broken text.

Michael Van Canneyt

2019-02-20 15:09

administrator   ~0114297

I pressed 10 times, file remains correct.

Did you apply the change with UTF8Decode ?

Alexey Tor.

2019-02-20 16:39

reporter   ~0114300

Yes, applied it.
After 3 presses I got broken file:

{ "проверка фигни" : "фигня", "проверка фигни" : "фигня", "проверка фигни" : "фигня" }

you see that 1st write is ok, next it reads wrong value and writes wrong value.

Michael Van Canneyt

2019-02-20 17:03

administrator   ~0114302

Seems like an encoding issue somewhere.

I work on Linux, and there all works fine. But there the default encoding is UTF8.
So probably somewhere along the way, the data gets corrupted by a faulty encoding...

This will need serious debugging...

Do-wan Kim

2019-02-25 03:41

reporter  

fpjson.pp-35113.patch (1,383 bytes)
Index: packages/fcl-json/src/fpjson.pp
===================================================================
--- packages/fcl-json/src/fpjson.pp	(revision 41455)
+++ packages/fcl-json/src/fpjson.pp	(working copy)
@@ -2496,7 +2496,7 @@
       vtChar       : Result:=CreateJSON(VChar);
       vtExtended   : Result:=CreateJSON(VExtended^);
       vtString     : Result:=CreateJSON(vString^);
-      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
+      vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
       vtPChar      : Result:=CreateJSON(StrPas(VPChar));
       vtPointer    : If (VPointer<>Nil) then
                        TJSONData.DoError(SErrPointerNotNil,[SourceType])
@@ -3153,7 +3153,7 @@
 
 Var
   I : integer;
-  AName : String;
+  AName : TJSONUnicodeStringType;
   J : TJSONData;
 
 begin
@@ -3173,7 +3173,7 @@
       Case VType of
         vtChar       : AName:=VChar;
         vtString     : AName:=vString^;
-        vtAnsiString : AName:=(AnsiString(vAnsiString));
+        vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
         vtPChar      : AName:=StrPas(VPChar);
       else
         DoError(SErrNameMustBeString,[I+1]);
@@ -3183,7 +3183,7 @@
       DoError(SErrNameMustBeString,[I+1]);
     Inc(I);
     J:=VarRecToJSON(Elements[i],'Object');
-    Add(AName,J);
+    Add(UTF8Encode(AName),J);
     Inc(I);
     end;
 end;
fpjson.pp-35113.patch (1,383 bytes)

Do-wan Kim

2019-02-25 03:43

reporter   ~0114395

String encoding is lost in array constant conversions.

Michael Van Canneyt

2019-02-25 09:34

administrator   ~0114396

Last edited: 2019-02-25 09:37

View 2 revisions

Ah, thank you for the patch. I will look at it tonight !

Indeed, the code dates from before codepage support, this seems to be a location which was not converted correctly... :(

Do-wan Kim

2019-02-25 12:02

reporter  

jsonconf-35113.patch (4,810 bytes)
Index: packages/fcl-json/src/fpjson.pp
===================================================================
--- packages/fcl-json/src/fpjson.pp	(revision 41455)
+++ packages/fcl-json/src/fpjson.pp	(working copy)
@@ -2496,7 +2496,7 @@
       vtChar       : Result:=CreateJSON(VChar);
       vtExtended   : Result:=CreateJSON(VExtended^);
       vtString     : Result:=CreateJSON(vString^);
-      vtAnsiString : Result:=CreateJSON(AnsiString(vAnsiString));
+      vtAnsiString : Result:=CreateJSON(UTF8Decode(StrPas(VPChar)));
       vtPChar      : Result:=CreateJSON(StrPas(VPChar));
       vtPointer    : If (VPointer<>Nil) then
                        TJSONData.DoError(SErrPointerNotNil,[SourceType])
@@ -3153,7 +3153,7 @@
 
 Var
   I : integer;
-  AName : String;
+  AName : TJSONUnicodeStringType;
   J : TJSONData;
 
 begin
@@ -3173,7 +3173,7 @@
       Case VType of
         vtChar       : AName:=VChar;
         vtString     : AName:=vString^;
-        vtAnsiString : AName:=(AnsiString(vAnsiString));
+        vtAnsiString : AName:=UTF8Decode(StrPas(VPChar));
         vtPChar      : AName:=StrPas(VPChar);
       else
         DoError(SErrNameMustBeString,[I+1]);
@@ -3183,7 +3183,7 @@
       DoError(SErrNameMustBeString,[I+1]);
     Inc(I);
     J:=VarRecToJSON(Elements[i],'Object');
-    Add(AName,J);
+    Add(UTF8Encode(AName),J);
     Inc(I);
     end;
 end;
Index: packages/fcl-json/src/jsonconf.pp
===================================================================
--- packages/fcl-json/src/jsonconf.pp	(revision 41455)
+++ packages/fcl-json/src/jsonconf.pp	(working copy)
@@ -97,6 +97,7 @@
     Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
     Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: TStrings): Boolean; overload;
     procedure SetValue(const APath: UnicodeString; const AValue: UnicodeString); overload;
+    procedure SetValue(const APath: RawByteString; const AValue: RawByteString); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Integer); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Int64); overload;
     procedure SetValue(const APath: UnicodeString; AValue: Boolean); overload;
@@ -418,6 +419,12 @@
   FModified:=True;
 end;
 
+procedure TJSONConfig.SetValue(const APath: RawByteString;
+  const AValue: RawByteString);
+begin
+  SetValue(UTF8Decode(APath),UTF8Decode(AValue));
+end;
+
 procedure TJSONConfig.SetDeleteValue(const APath: UnicodeString; const AValue, DefValue: UnicodeString);
 begin
   if AValue = DefValue then
Index: packages/fcl-json/src/jsonreader.pp
===================================================================
--- packages/fcl-json/src/jsonreader.pp	(revision 41455)
+++ packages/fcl-json/src/jsonreader.pp	(working copy)
@@ -36,7 +36,7 @@
     procedure DoError(const Msg: String);
     Procedure DoParse(AtCurrent,AllowEOF: Boolean);
     function GetNextToken: TJSONToken;
-    function CurrentTokenString: String;
+    function CurrentTokenString: RawByteString;
     function CurrentToken: TJSONToken; inline;
 
     Procedure KeyValue(Const AKey : TJSONStringType); virtual; abstract;
@@ -203,7 +203,7 @@
   Result:=FScanner.CurToken;
 end;
 
-function TBaseJSONReader.CurrentTokenString: String;
+function TBaseJSONReader.CurrentTokenString: RawByteString;
 
 begin
   If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then
Index: packages/fcl-json/src/jsonscanner.pp
===================================================================
--- packages/fcl-json/src/jsonscanner.pp	(revision 41455)
+++ packages/fcl-json/src/jsonscanner.pp	(working copy)
@@ -28,7 +28,7 @@
 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';
+  SErrOpenString = 'string exceeds end of line %d';
 
 type
 
@@ -331,7 +331,7 @@
                       u1:=u2;
                       end
                     end;
-              #0  : Error(SErrOpenString);
+              #0  : Error(SErrOpenString,[FCurRow]);
             else
               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             end;
@@ -355,11 +355,11 @@
           else
             MaybeAppendUnicode;
           if FTokenStr[0] = #0 then
-            Error(SErrOpenString);
+            Error(SErrOpenString,[FCurRow]);
           Inc(FTokenStr);
           end;
         if FTokenStr[0] = #0 then
-          Error(SErrOpenString);
+          Error(SErrOpenString,[FCurRow]);
         MaybeAppendUnicode;
         SectionLength := FTokenStr - TokenStart;
         SetLength(FCurTokenString, OldLength + SectionLength);
jsonconf-35113.patch (4,810 bytes)

Do-wan Kim

2019-02-25 12:06

reporter   ~0114401

I misunderstanding issue.

SetValue works with second patch.

Michael Van Canneyt

2019-02-25 22:00

administrator   ~0114431

I have applied the patch, but added overloaded versions that accept UTF8 strings for the path and value.

Note that they still return a unicodestring, so if you want to show it in a Lazarus memo, you need to do a UTF8Encode before displaying it.

Issue History

Date Modified Username Field Change
2019-02-18 17:32 Alexey Tor. New Issue
2019-02-18 17:33 Alexey Tor. File Added: tst-json-enc-bug.zip
2019-02-18 17:34 Alexey Tor. Note Added: 0114241
2019-02-18 20:08 Michael Van Canneyt Assigned To => Michael Van Canneyt
2019-02-18 20:08 Michael Van Canneyt Status new => assigned
2019-02-19 22:43 Alexey Tor. Note Added: 0114273
2019-02-19 23:34 Michael Van Canneyt Note Added: 0114276
2019-02-20 09:48 Alexey Tor. Note Added: 0114286
2019-02-20 09:51 Michael Van Canneyt Note Added: 0114287
2019-02-20 12:41 Alexey Tor. Note Added: 0114291
2019-02-20 12:42 Alexey Tor. Note Edited: 0114291 View Revisions
2019-02-20 12:43 Alexey Tor. Note Edited: 0114291 View Revisions
2019-02-20 13:15 Michael Van Canneyt Note Added: 0114293
2019-02-20 13:15 Michael Van Canneyt Note Edited: 0114293 View Revisions
2019-02-20 13:51 Michael Van Canneyt Note Added: 0114295
2019-02-20 13:51 Michael Van Canneyt Status assigned => resolved
2019-02-20 13:51 Michael Van Canneyt Resolution open => no change required
2019-02-20 13:59 Alexey Tor. Note Added: 0114296
2019-02-20 13:59 Alexey Tor. Status resolved => feedback
2019-02-20 13:59 Alexey Tor. Resolution no change required => reopened
2019-02-20 15:09 Michael Van Canneyt Note Added: 0114297
2019-02-20 16:39 Alexey Tor. Note Added: 0114300
2019-02-20 16:39 Alexey Tor. Status feedback => assigned
2019-02-20 17:03 Michael Van Canneyt Note Added: 0114302
2019-02-25 03:41 Do-wan Kim File Added: fpjson.pp-35113.patch
2019-02-25 03:43 Do-wan Kim Note Added: 0114395
2019-02-25 09:34 Michael Van Canneyt Note Added: 0114396
2019-02-25 09:37 Michael Van Canneyt Note Edited: 0114396 View Revisions
2019-02-25 12:02 Do-wan Kim File Added: jsonconf-35113.patch
2019-02-25 12:06 Do-wan Kim Note Added: 0114401
2019-02-25 22:00 Michael Van Canneyt Note Added: 0114431
2019-02-25 22:00 Michael Van Canneyt Status assigned => resolved
2019-02-25 22:00 Michael Van Canneyt Fixed in Version => 3.3.1
2019-02-25 22:00 Michael Van Canneyt Resolution reopened => fixed
2019-02-25 22:00 Michael Van Canneyt Target Version => 3.2.0
2019-02-25 22:04 Michael Van Canneyt Fixed in Revision => 41473