Browse Source

* Fix bug ID #35113

git-svn-id: trunk@41473 -
michael 6 years ago
parent
commit
970188907e

+ 4 - 4
packages/fcl-json/src/fpjson.pp

@@ -2496,7 +2496,7 @@ begin
       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 @@ constructor TJSONObject.Create(const Elements: array of {$ifdef pas2js}jsvalue{$
 
 Var
   I : integer;
-  AName : String;
+  AName : TJSONUnicodeStringType;
   J : TJSONData;
 
 begin
@@ -3173,7 +3173,7 @@ begin
       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 @@ begin
       DoError(SErrNameMustBeString,[I+1]);
     Inc(I);
     J:=VarRecToJSON(Elements[i],'Object');
-    Add(AName,J);
+    Add(UTF8Encode(AName),J);
     Inc(I);
     end;
 end;

+ 53 - 0
packages/fcl-json/src/jsonconf.pp

@@ -90,13 +90,21 @@ type
     Procedure EnumValues(Const APath : UnicodeString; List : TStrings);
 
     function  GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString; overload;
+    function  GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Integer): Integer; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Integer): Integer; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Int64): Int64; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Int64): Int64; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Boolean): Boolean; overload;
     function  GetValue(const APath: UnicodeString; ADefault: Double): Double; overload;
+    function  GetValue(const APath: RawByteString; ADefault: Double): Double; overload;
     Function GetValue(const APath: UnicodeString; AValue: TStrings; Const ADefault: String) : Boolean; overload;
+    Function GetValue(const APath: RawByteString; 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;
@@ -289,6 +297,12 @@ begin
 end;
 
 
+function TJSONConfig.GetValue(const APath: RawByteString; const ADefault: RawByteString): UnicodeString;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),UTF8Decode(ADefault));
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; const ADefault: UnicodeString): UnicodeString;
 
 var
@@ -302,6 +316,12 @@ begin
     Result:=ADefault;
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Integer): Integer;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Integer): Integer;
 var
   El : TJSONData;
@@ -316,6 +336,12 @@ begin
     Result:=StrToIntDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Int64): Int64;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Int64): Int64;
 var
   El : TJSONData;
@@ -330,6 +356,12 @@ begin
     Result:=StrToInt64Def(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Boolean): Boolean;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Boolean): Boolean;
 
 var
@@ -345,6 +377,12 @@ begin
     Result:=StrToBoolDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; ADefault: Double): Double;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),ADefault);
+end;
+
 function TJSONConfig.GetValue(const APath: UnicodeString; ADefault: Double): Double;
 
 var
@@ -360,6 +398,14 @@ begin
     Result:=StrToFloatDef(El.AsString,ADefault);
 end;
 
+function TJSONConfig.GetValue(const APath: RawByteString; AValue: TStrings;
+  const ADefault: String): Boolean;
+
+begin
+  Result:=GetValue(UTF8Decode(aPath),AValue, ADefault);
+end;
+
+
 function TJSONConfig.GetValue(const APath: UnicodeString; AValue: TStrings;
   const ADefault: String): Boolean;
 var
@@ -418,6 +464,13 @@ begin
   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

+ 2 - 2
packages/fcl-json/src/jsonreader.pp

@@ -36,7 +36,7 @@ Type
     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 @@ begin
   Result:=FScanner.CurToken;
 end;
 
-function TBaseJSONReader.CurrentTokenString: String;
+function TBaseJSONReader.CurrentTokenString: RawByteString;
 
 begin
   If CurrentToken in [tkString,tkIdentifier,tkNumber,tkComment] then

+ 4 - 4
packages/fcl-json/src/jsonscanner.pp

@@ -28,7 +28,7 @@ uses SysUtils, Classes;
 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 @@ begin
                       u1:=u2;
                       end
                     end;
-              #0  : Error(SErrOpenString);
+              #0  : Error(SErrOpenString,[FCurRow]);
             else
               Error(SErrInvalidCharacter, [CurRow,CurColumn,FTokenStr[0]]);
             end;
@@ -355,11 +355,11 @@ begin
           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);

+ 29 - 0
packages/fcl-json/tests/jsonconftest.pp

@@ -27,6 +27,7 @@ type
     procedure TestKey;
     procedure TestStrings;
     procedure TestUnicodeStrings;
+    procedure TestUnicodeStrings2;
   end;
 
 implementation
@@ -352,6 +353,34 @@ begin
   end;
 end;
 
+procedure TTestJSONConfig.TestUnicodeStrings2;
+
+Const
+  utf8str = 'Größe ÄÜÖ ㎰ す 가';
+  utf8path = 'Größe/す가';
+
+Var
+  Co : TJSONCOnfig;
+
+
+begin
+  Co:=CreateConf('test.json');
+  try
+    Co.SetValue('/проверка',utf8str);
+    Co.SetValue(utf8path,'something');
+    Co.Flush;
+  finally
+    co.Free;
+  end;
+  Co:=CreateConf('test.json');
+  try
+    AssertEquals('UTF8 string read/Write',utf8str,utf8encode(Co.GetValue('/проверка','')));
+    AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
+  finally
+    DeleteConf(Co,True);
+  end;
+end;
+
 
 initialization
 

+ 0 - 3
packages/fcl-json/tests/testjsonconf.lpi

@@ -14,9 +14,6 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>