paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-25 18:09:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Better unicode string support. Changed TJSONStringType to UTF8String (bug ID 28966)

Browse Source 
git-svn-id: trunk@32774 -
This commit is contained in:
michael 2015-12-28 10:53:32 +00:00
parent 1287a8b0e8
commit 9689bcc34b
8 changed files with 183 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -30,7 +30,8 @@ type
TJSONInstanceType = (jitUnknown, jitNumberInteger,jitNumberInt64,jitNumberQWord,jitNumberFloat,
jitString, jitBoolean, jitNull, jitArray, jitObject);
TJSONFloat = Double;
TJSONStringType = AnsiString;
TJSONStringType = UTF8String;
TJSONUnicodeStringType = Unicodestring;
TJSONCharType = AnsiChar;
PJSONCharType = ^TJSONCharType;
TFormatOption = (foSingleLineArray, // Array without CR/LF : all on one line
@ -99,6 +100,8 @@ Type
function GetAsJSON: TJSONStringType; virtual; abstract;
function GetAsString: TJSONStringType; virtual; abstract;
procedure SetAsString(const AValue: TJSONStringType); virtual; abstract;
function GetAsUnicodeString: TJSONUnicodeStringType; virtual;
procedure SetAsUnicodeString(const AValue: TJSONUnicodeStringType); virtual;
function GetValue: variant; virtual; abstract;
procedure SetValue(const AValue: variant); virtual; abstract;
function GetItem(Index : Integer): TJSONData; virtual;
@ -122,6 +125,7 @@ Type
property Items[Index: Integer]: TJSONData read GetItem write SetItem;
property Value: variant read GetValue write SetValue;
Property AsString : TJSONStringType Read GetAsString Write SetAsString;
Property AsUnicodeString : TJSONUnicodeStringType Read GetAsUnicodeString Write SetAsUnicodeString;
Property AsFloat : TJSONFloat Read GetAsFloat Write SetAsFloat;
Property AsInteger : Integer Read GetAsInteger Write SetAsInteger;
Property AsInt64 : Int64 Read GetAsInt64 Write SetAsInt64;
@ -281,6 +285,7 @@ Type
procedure SetAsString(const AValue: TJSONStringType); override;
public
Constructor Create(const AValue : TJSONStringType); reintroduce;
Constructor Create(const AValue : TJSONUnicodeStringType); reintroduce;
class function JSONType: TJSONType; override;
Procedure Clear; override;
Function Clone : TJSONData; override;
@ -361,6 +366,7 @@ Type
function GetObjects(Index : Integer): TJSONObject;
function GetQWords(Index : Integer): QWord;
function GetStrings(Index : Integer): TJSONStringType;
function GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
function GetTypes(Index : Integer): TJSONType;
procedure SetArrays(Index : Integer; const AValue: TJSONArray);
procedure SetBooleans(Index : Integer; const AValue: Boolean);
@ -370,6 +376,7 @@ Type
procedure SetObjects(Index : Integer; const AValue: TJSONObject);
procedure SetQWords(Index : Integer; AValue: QWord);
procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
procedure SetUnicodeStrings(Index : Integer; const AValue: TJSONUnicodeStringType);
protected
Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
Procedure Converterror(From : Boolean);
@ -409,6 +416,7 @@ Type
function Add(I : Int64): Int64;
function Add(I : QWord): QWord;
function Add(const S : String): Integer;
function Add(const S : UnicodeString): Integer;
function Add: Integer;
function Add(F : TJSONFloat): Integer;
function Add(B : Boolean): Integer;
@ -424,6 +432,7 @@ Type
procedure Insert(Index: Integer; I : Int64);
procedure Insert(Index: Integer; I : QWord);
procedure Insert(Index: Integer; const S : String);
procedure Insert(Index: Integer; const S : UnicodeString);
procedure Insert(Index: Integer; F : TJSONFloat);
procedure Insert(Index: Integer; B : Boolean);
procedure Insert(Index: Integer; AnArray : TJSONArray);
@ -439,6 +448,7 @@ Type
Property Int64s[Index : Integer] : Int64 Read GetInt64s Write SetInt64s;
Property QWords[Index : Integer] : QWord Read GetQWords Write SetQWords;
Property Strings[Index : Integer] : TJSONStringType Read GetStrings Write SetStrings;
Property UnicodeStrings[Index : Integer] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
Property Floats[Index : Integer] : TJSONFloat Read GetFloats Write SetFloats;
Property Booleans[Index : Integer] : Boolean Read GetBooleans Write SetBooleans;
Property Arrays[Index : Integer] : TJSONArray Read GetArrays Write SetArrays;
@ -474,6 +484,7 @@ Type
function GetObjects(const AName : String): TJSONObject;
function GetQWords(AName : String): QWord;
function GetStrings(const AName : String): TJSONStringType;
function GetUnicodeStrings(const AName : String): TJSONUnicodeStringType;
function GetTypes(const AName : String): TJSONType;
procedure SetArrays(const AName : String; const AValue: TJSONArray);
procedure SetBooleans(const AName : String; const AValue: Boolean);
@ -485,6 +496,7 @@ Type
procedure SetObjects(const AName : String; const AValue: TJSONObject);
procedure SetQWords(AName : String; AValue: QWord);
procedure SetStrings(const AName : String; const AValue: TJSONStringType);
procedure SetUnicodeStrings(const AName : String; const AValue: TJSONUnicodeStringType);
class function GetUnquotedMemberNames: Boolean; static;
class procedure SetUnquotedMemberNames(AValue: Boolean); static;
protected
@ -529,7 +541,8 @@ Type
Function Get(Const AName : String; ADefault : Int64) : Int64;
Function Get(Const AName : String; ADefault : QWord) : QWord;
Function Get(Const AName : String; ADefault : Boolean) : Boolean;
Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringTYpe;
Function Get(Const AName : String; ADefault : TJSONStringType) : TJSONStringType;
Function Get(Const AName : String; ADefault : TJSONUnicodeStringType) : TJSONUnicodeStringType;
Function Get(Const AName : String; ADefault : TJSONArray) : TJSONArray;
Function Get(Const AName : String; ADefault : TJSONObject) : TJSONObject;
// Manipulate
@ -538,6 +551,7 @@ Type
function Add(const AName: TJSONStringType; AValue: Boolean): Integer; overload;
function Add(const AName: TJSONStringType; AValue: TJSONFloat): Integer; overload;
function Add(const AName, AValue: TJSONStringType): Integer; overload;
function Add(const AName : String; AValue: TJSONUnicodeStringType): Integer; overload;
function Add(const AName: TJSONStringType; Avalue: Integer): Integer; overload;
function Add(const AName: TJSONStringType; Avalue: Int64): Integer; overload;
function Add(const AName: TJSONStringType; Avalue: QWord): Integer; overload;
@ -560,6 +574,7 @@ Type
Property Int64s[AName : String] : Int64 Read GetInt64s Write SetInt64s;
Property QWords[AName : String] : QWord Read GetQWords Write SetQWords;
Property Strings[AName : String] : TJSONStringType Read GetStrings Write SetStrings;
Property UnicodeStrings[AName : String] : TJSONUnicodeStringType Read GetUnicodeStrings Write SetUnicodeStrings;
Property Booleans[AName : String] : Boolean Read GetBooleans Write SetBooleans;
Property Arrays[AName : String] : TJSONArray Read GetArrays Write SetArrays;
Property Objects[AName : String] : TJSONObject Read GetObjects Write SetObjects;
@ -585,6 +600,7 @@ Function CreateJSON(Data : Int64) : TJSONInt64Number;
Function CreateJSON(Data : QWord) : TJSONQWordNumber;
Function CreateJSON(Data : TJSONFloat) : TJSONFloatNumber;
Function CreateJSON(Data : TJSONStringType) : TJSONString;
Function CreateJSON(Data : TJSONUnicodeStringType) : TJSONString;
Function CreateJSONArray(Data : Array of const) : TJSONArray;
Function CreateJSONObject(Data : Array of const) : TJSONObject;
@ -647,7 +663,7 @@ begin
Result:=DefaultJSONInstanceTypes[AType]
end;
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
function StringToJSONString(const S: TJSONStringType): TJSONStringType;
Var
I,J,L : Integer;
@ -682,7 +698,7 @@ begin
Result:=Result+Copy(S,J,I-1);
end;
Function JSONStringToString(const S : TJSONStringType) : TJSONStringType;
function JSONStringToString(const S: TJSONStringType): TJSONStringType;
Var
I,J,L : Integer;
@ -768,6 +784,11 @@ begin
Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
end;
function CreateJSON(Data: TJSONUnicodeStringType): TJSONString;
begin
Result:=TJSONStringCLass(DefaultJSONInstanceTypes[jitString]).Create(Data);
end;
function CreateJSONArray(Data: array of const): TJSONArray;
begin
Result:=TJSONArrayCLass(DefaultJSONInstanceTypes[jitArray]).Create(Data);
@ -781,7 +802,8 @@ end;
Var
JPH : TJSONParserHandler;
function GetJSON(const JSON: TJSONStringType; Const UseUTF8: Boolean): TJSONData;
function GetJSON(const JSON: TJSONStringType; const UseUTF8: Boolean
): TJSONData;
Var
SS : TStringStream;
@ -794,7 +816,7 @@ begin
end;
end;
function GetJSON(Const JSON: TStream; Const UseUTF8: Boolean): TJSONData;
function GetJSON(const JSON: TStream; const UseUTF8: Boolean): TJSONData;
begin
Result:=Nil;
@ -1011,6 +1033,17 @@ end;
{ TJSONData }
function TJSONData.GetAsUnicodeString: TJSONUnicodeStringType;
begin
Result:=UTF8Decode(AsString);
end;
procedure TJSONData.SetAsUnicodeString(const AValue: TJSONUnicodeStringType);
begin
AsString:=UTF8Encode(AValue);
end;
function TJSONData.GetItem(Index : Integer): TJSONData;
begin
@ -1136,7 +1169,7 @@ end;
function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
Var
M : String;
M : TJSONStringType;
begin
Result:=DoFindPath(APath,M);
@ -1145,7 +1178,7 @@ end;
function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
Var
M : String;
M : TJSONStringType;
begin
Result:=DoFindPath(APath,M);
If Result=Nil then
@ -1286,6 +1319,11 @@ begin
FValue:=AValue;
end;
constructor TJSONString.Create(const AValue: TJSONUnicodeStringType);
begin
FValue:=UTF8Encode(AValue);
end;
{ TJSONboolean }
@ -1383,6 +1421,7 @@ begin
FValue:=StrToBool(AValue);
end;
constructor TJSONBoolean.Create(AValue: Boolean);
begin
FValue:=AValue;
@ -1469,6 +1508,7 @@ begin
ConvertError(True);
end;
function TJSONNull.GetValue: variant;
begin
Result:=variants.Null;
@ -1564,16 +1604,15 @@ begin
end;
procedure TJSONFloatNumber.SetAsString(const AValue: TJSONStringType);
Var
C : Integer;
begin
Val(AValue,FValue,C);
If (C<>0) then
Raise EConvertError.CreateFmt(SErrInvalidFloat,[AValue]);
end;
function TJSONFloatNumber.GetValue: variant;
begin
Result:=FValue;
@ -1672,6 +1711,7 @@ begin
FValue:=StrToInt(AValue);
end;
function TJSONIntegerNumber.GetValue: variant;
begin
Result:=FValue;
@ -1848,6 +1888,11 @@ begin
Result:=Items[Index].AsString;
end;
function TJSONArray.GetUnicodeStrings(Index : Integer): TJSONUnicodeStringType;
begin
Result:=Items[Index].AsUnicodeString;
end;
function TJSONArray.GetTypes(Index : Integer): TJSONType;
begin
Result:=Items[Index].JSONType;
@ -1894,6 +1939,12 @@ begin
Items[Index]:=CreateJSON(AValue);
end;
procedure TJSONArray.SetUnicodeStrings(Index: Integer;
const AValue: TJSONUnicodeStringType);
begin
Items[Index]:=CreateJSON(AValue);
end;
function TJSONArray.DoFindPath(const APath: TJSONStringType; out
NotFound: TJSONStringType): TJSONdata;
@ -2226,6 +2277,11 @@ begin
Result:=Add(CreateJSON(S));
end;
function TJSONArray.Add(const S: UnicodeString): Integer;
begin
Result:=Add(CreateJSON(S));
end;
function TJSONArray.Add: Integer;
begin
Result:=Add(CreateJSON);
@ -2305,6 +2361,11 @@ begin
FList.Insert(Index, CreateJSON(S));
end;
procedure TJSONArray.Insert(Index: Integer; const S: UnicodeString);
begin
FList.Insert(Index, CreateJSON(S));
end;
procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
begin
FList.Insert(Index, CreateJSON(F));
@ -2403,6 +2464,12 @@ begin
Result:=GetElements(AName).AsString;
end;
function TJSONObject.GetUnicodeStrings(const AName: String
): TJSONUnicodeStringType;
begin
Result:=GetElements(AName).AsUnicodeString;
end;
function TJSONObject.GetTypes(const AName : String): TJSONType;
begin
Result:=Getelements(Aname).JSONType;
@ -2470,7 +2537,13 @@ end;
procedure TJSONObject.SetStrings(const AName : String; const AValue: TJSONStringType);
begin
SetElements(AName,CreateJSON(AVAlue));
SetElements(AName,CreateJSON(AValue));
end;
procedure TJSONObject.SetUnicodeStrings(const AName: String;
const AValue: TJSONUnicodeStringType);
begin
SetElements(AName,CreateJSON(AValue));
end;
class procedure TJSONObject.DetermineElementQuotes;
@ -2829,6 +2902,12 @@ begin
Result:=Add(AName,CreateJSON(AValue));
end;
function TJSONObject.Add(const AName: String; AValue: TJSONUnicodeStringType
): Integer;
begin
Result:=Add(AName,CreateJSON(AValue));
end;
function TJSONObject.Add(const AName: TJSONStringType; Avalue: Integer): Integer;
begin
Result:=Add(AName,CreateJSON(AValue));
@ -2973,7 +3052,7 @@ begin
end;
function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
): TJSONStringTYpe;
): TJSONStringType;
Var
D : TJSONData;
@ -2985,6 +3064,19 @@ begin
Result:=ADefault;
end;
function TJSONObject.Get(const AName: String; ADefault: TJSONUnicodeStringType
): TJSONUnicodeStringType;
Var
D : TJSONData;
begin
D:=Find(AName,jtString);
If (D<>Nil) then
Result:=D.AsUnicodeString
else
Result:=ADefault;
end;
function TJSONObject.Get(const AName: String; ADefault: TJSONArray
): TJSONArray;
Var

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

@ -400,7 +400,7 @@ begin
tkAString:
SetStrProp(AObject,PI,PropData.AsString);
tkWString :
SetWideStrProp(AObject,PI,PropData.AsString);
SetWideStrProp(AObject,PI,PropData.AsUnicodeString);
tkVariant:
SetVariantProp(AObject,PI,JSONToVariant(PropData));
tkClass:
@ -425,7 +425,7 @@ begin
tkMethod :
Error(SErrUnsupportedPropertyKind,[PI^.Name]);
tkUString :
SetUnicodeStrProp(AObject,PI,PropData.AsString);
SetUnicodeStrProp(AObject,PI,PropData.AsUnicodeString);
tkUChar:
begin
JS:=PropData.asString;

50
packages/fcl-json/src/jsonconf.pp
View File

@ -28,7 +28,7 @@ unit jsonConf;
interface
uses
SysUtils, Classes, fpjson, jsonscanner,jsonparser;
SysUtils, Classes, fpjson, jsonscanner, jsonparser;
type
@ -206,7 +206,7 @@ begin
If (Result.Count=0) then
I:=-1
else
I:=Result.IndexOfName(El);
I:=Result.IndexOfName(UTF8Encode(El));
If (I=-1) then
// No element with this name.
begin
@ -215,7 +215,7 @@ begin
// Create new node.
T:=Result;
Result:=TJSonObject.Create;
T.Add(El,Result);
T.Add(UTF8Encode(El),Result);
end
else
Result:=Nil
@ -224,7 +224,7 @@ begin
// Node found, check if it is an object
begin
if (Result.Items[i].JSONtype=jtObject) then
Result:=Result.Objects[el]
Result:=Result.Objects[UTF8Encode(el)]
else
begin
// Writeln(el,' type wrong');
@ -234,7 +234,7 @@ begin
Result.Delete(I);
T:=Result;
Result:=TJSonObject.Create;
T.Add(El,Result);
T.Add(UTF8Encode(El),Result);
end
else
Result:=Nil
@ -270,7 +270,7 @@ begin
If Assigned(Aparent) then
begin
// Writeln('Found parent, looking for element:',elName);
I:=AParent.IndexOfName(ElName);
I:=AParent.IndexOfName(UTF8Encode(ElName));
// Writeln('Element index is',I);
If (I<>-1) And ((AParent.items[I].JSONType<>jtObject) or AllowObject) then
Result:=AParent.Items[i];
@ -287,7 +287,7 @@ var
begin
El:=FindElement(StripSlash(APath),False);
If Assigned(El) then
Result:=UTF8Decode(El.AsString)
Result:=El.AsUnicodeString
else
Result:=ADefault;
end;
@ -401,17 +401,17 @@ begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (El.JSONType<>jtString) then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONString.Create(UTF8encode(AValue));
O.Add(ElName,El);
El:=TJSONString.Create(AValue);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsString:=UTF8Encode(AValue);
El.AsUnicodeString:=AValue;
FModified:=True;
end;
@ -435,7 +435,7 @@ begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONIntegerNumber)) then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
If (I<>-1) then // Normally not needed...
O.Delete(i);
El:=Nil;
@ -443,7 +443,7 @@ begin
If Not Assigned(el) then
begin
El:=TJSONIntegerNumber.Create(AValue);
O.Add(ElName,El);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsInteger:=AValue;
@ -462,7 +462,7 @@ begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONInt64Number)) then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
If (I<>-1) then // Normally not needed...
O.Delete(i);
El:=Nil;
@ -470,7 +470,7 @@ begin
If Not Assigned(el) then
begin
El:=TJSONInt64Number.Create(AValue);
O.Add(ElName,El);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsInt64:=AValue;
@ -507,14 +507,14 @@ begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (el.JSONType<>jtBoolean) then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONBoolean.Create(AValue);
O.Add(ElName,El);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsBoolean:=AValue;
@ -533,14 +533,14 @@ begin
El:=FindElement(StripSlash(APath),True,O,ElName);
if Assigned(El) and (Not (El is TJSONFloatNumber)) then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
If Not Assigned(el) then
begin
El:=TJSONFloatNumber.Create(AValue);
O.Add(ElName,El);
O.Add(UTF8Encode(ElName),El);
end
else
El.AsFloat:=AValue;
@ -567,7 +567,7 @@ begin
DoDelete:=(Not (El is TJSONArray));
if DoDelete then
begin
I:=O.IndexOfName(elName);
I:=O.IndexOfName(UTF8Encode(elName));
O.Delete(i);
El:=Nil;
end;
@ -578,7 +578,7 @@ begin
El:=TJSONObject.Create
else
El:=TJSONArray.Create;
O.Add(ElName,El);
O.Add(UTF8Encode(ElName),El);
end;
if Not AsObject then
begin
@ -611,7 +611,7 @@ end;
procedure TJSONConfig.DeletePath(const APath: UnicodeString);
Var
P : String;
P : UnicodeString;
L : integer;
Node : TJSONObject;
ElName : UnicodeString;
@ -624,7 +624,7 @@ begin
Node := FindObject(P,False,ElName);
If Assigned(Node) then
begin
L:=Node.IndexOfName(ElName);
L:=Node.IndexOfName(UTF8Encode(ElName));
If (L<>-1) then
Node.Delete(L);
end;
@ -643,6 +643,7 @@ begin
if Length(Filename) > 0 then
DoSetFilename(Filename,True);
end;
procedure TJSONConfig.Loaded;
begin
inherited Loaded;
@ -733,8 +734,9 @@ end;
procedure TJSONConfig.OpenKey(const aPath: UnicodeString; AllowCreate: Boolean);
Var
P : String;
P : UnicodeString;
L : Integer;
begin
P:=APath;
L:=Length(P);

17
packages/fcl-json/src/jsonparser.pp
View File

@ -82,7 +82,7 @@ Var
begin
Data:=Nil;
P:=TJSONParser.Create(AStream,AUseUTF8);
P:=TJSONParser.Create(AStream,[joUTF8]);
try
Data:=P.Parse;
finally
@ -138,7 +138,10 @@ begin
tkNull : Result:=CreateJSON;
tkTrue,
tkFalse : Result:=CreateJSON(t=tkTrue);
tkString : Result:=CreateJSON(CurrentTokenString);
tkString : if joUTF8 in Options then
Result:=CreateJSON(UTF8Decode(CurrentTokenString))
else
Result:=CreateJSON(CurrentTokenString);
tkCurlyBraceOpen : Result:=ParseObject;
tkCurlyBraceClose : DoError(SErrUnexpectedToken);
tkSQuaredBraceOpen : Result:=ParseArray;
@ -320,15 +323,17 @@ end;
constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
begin
Inherited Create;
FScanner:=TJSONScanner.Create(Source);
UseUTF8:=AUseUTF8;
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
if AUseUTF8 then
Options:=Options + [joUTF8];
end;
constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
begin
Inherited Create;
FScanner:=TJSONScanner.Create(Source);
UseUTF8:=AUseUTF8;
FScanner:=TJSONScanner.Create(Source,[joUTF8]);
if AUseUTF8 then
Options:=Options + [joUTF8];
end;
constructor TJSONParser.Create(Source: TStream; AOptions: TJSONOptions);

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

@ -247,7 +247,7 @@ begin
'"','''':
begin
C:=TokenStr[0];
If (C='''') and Strict then
If (C='''') and (joStrict in Options) then
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
Inc(TokenStr);
TokenStart := TokenStr;
@ -284,7 +284,7 @@ begin
end;
end;
// WideChar takes care of conversion...
if UseUTF8 then
if (joUTF8 in Options) then
S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
else
S:=WideChar(StrToInt('$'+S));
@ -442,7 +442,7 @@ begin
FCurToken := Result;
exit;
end;
if Strict then
if (joStrict in Options) then
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]])
else
Result:=tkIdentifier;

35
packages/fcl-json/tests/jsonconftest.pp
View File

@ -1,6 +1,7 @@
unit jsonconftest;
{$mode objfpc}{$H+}
{$codepage utf8}
interface
@ -25,6 +26,7 @@ type
procedure TestClear;
procedure TestKey;
procedure TestStrings;
procedure TestUnicodeStrings;
end;
implementation
@ -256,7 +258,8 @@ begin
end;
end;
procedure TTestJSONConfig.AssertStrings(Msg : String; L : TStrings; Const Values : Array of string);
procedure TTestJSONConfig.AssertStrings(Msg: String; L: TStrings;
const Values: array of string);
Var
I : Integer;
@ -313,7 +316,35 @@ begin
AssertStrings('int64',L,['1']);
finally
L.Free;
C.Free;
DeleteConf(C,True);
end;
end;
procedure TTestJSONConfig.TestUnicodeStrings;
Const
utf8str = 'Größe ÄÜÖ ㎰ す 가';
utf8path = 'Größe/す가';
Var
Co : TJSONCOnfig;
begin
Co:=CreateConf('test.json');
try
Co.SetValue('a',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('a','')));
AssertEquals('UTF8 path read/Write','something',Co.GetValue(utf8path,'something'));
finally
DeleteConf(Co,True);
end;
end;

1
packages/fcl-json/tests/testjson.lpi
View File

@ -4,6 +4,7 @@
<Version Value="9"/>
<General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>

6
packages/fcl-json/tests/testjsonparser.pp
View File

@ -218,11 +218,11 @@ begin
DoTestArray('[1234567890123456]',1);
DoTestArray('[1234567890123456, 2234567890123456]',2);
DoTestArray('[1234567890123456, 2234567890123456, 3234567890123456]',3);
Str(Double(1.2),S1);
Str(12/10,S1);
Delete(S1,1,1);
Str(Double(2.3),S2);
Str(34/10,S2);
Delete(S2,1,1);
Str(Double(3.4),S3);
Str(34/10,S3);
Delete(S3,1,1);
DoTestArray('['+S1+']',1);
DoTestArray('['+S1+', '+S2+']',2);