paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 16:49:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #35113

Browse Source 
git-svn-id: trunk@41473 -
This commit is contained in:
michael 2019-02-25 21:04:39 +00:00
parent c7834af354
commit 970188907e
6 changed files with 92 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
packages/fcl-json/src/fpjson.pp
View File

@ -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
packages/fcl-json/src/jsonconf.pp
View File

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

4
packages/fcl-json/src/jsonreader.pp
View File

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

8
packages/fcl-json/src/jsonscanner.pp
View File

@ -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
packages/fcl-json/tests/jsonconftest.pp
View File

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

3
packages/fcl-json/tests/testjsonconf.lpi
View File

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