paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 05:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patch from Luiz Americo to make set functions return previous value (bug ID 25795)

Browse Source 
git-svn-id: trunk@26940 -
This commit is contained in:
michael 2014-03-03 14:13:00 +00:00
parent 54e926fdb5
commit 2ae138d95c
4 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -69,7 +69,7 @@ Type
TJSONData = class(TObject)
protected
Class Procedure DoError(Const Msg : String);
Class Procedure DoError(Const Fmt : String; Args : Array of const);
Class Procedure DoError(Const Fmt : String; const Args : Array of const);
Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
function GetAsBoolean: Boolean; virtual; abstract;
function GetAsFloat: TJSONFloat; virtual; abstract;
@ -480,7 +480,7 @@ Type
TJSONParserHandler = Procedure(AStream : TStream; Const AUseUTF8 : Boolean; Out Data : TJSONData);
Procedure SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass);
Function SetJSONInstanceType(AType : TJSONInstanceType; AClass : TJSONDataClass) : TJSONDataClass;
Function GetJSONInstanceType(AType : TJSONInstanceType) : TJSONDataClass;
Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
@ -501,7 +501,7 @@ Function CreateJSONObject(Data : Array of const) : TJSONObject;
// When the jsonparser unit is included in the project, the callback is automatically set.
Function GetJSON(Const JSON : TJSONStringType; Const UseUTF8 : Boolean = True) : TJSONData;
Function GetJSON(Const JSON : TStream; Const UseUTF8 : Boolean = True) : TJSONData;
Procedure SetJSONParserHandler(AHandler : TJSONParserHandler);
Function SetJSONParserHandler(AHandler : TJSONParserHandler) : TJSONParserHandler;
Function GetJSONParserHandler : TJSONParserHandler;
implementation
@ -541,12 +541,13 @@ Const
TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
TJSONObject);
procedure SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass);
function SetJSONInstanceType(AType: TJSONInstanceType; AClass: TJSONDataClass): TJSONDataClass;
begin
if AClass=Nil then
TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONINstanceTypes[AType].ClassName]);
TJSONData.DoError(SErrWrongInstanceClass,['Nil',MinJSONInstanceTypes[AType].ClassName]);
if Not AClass.InheritsFrom(MinJSONINstanceTypes[AType]) then
TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONINstanceTypes[AType].ClassName]);
TJSONData.DoError(SErrWrongInstanceClass,[AClass.ClassName,MinJSONInstanceTypes[AType].ClassName]);
Result:=DefaultJSONInstanceTypes[AType];
DefaultJSONINstanceTypes[AType]:=AClass;
end;
@ -706,8 +707,9 @@ begin
JPH(JSON,UseUTF8,Result);
end;
procedure SetJSONParserHandler(AHandler: TJSONParserHandler);
function SetJSONParserHandler(AHandler: TJSONParserHandler): TJSONParserHandler;
begin
Result:=JPH;
JPH:=AHandler;
end;
@ -837,7 +839,7 @@ begin
Raise EJSON.Create(Msg);
end;
class procedure TJSONData.DoError(const Fmt: String; Args: array of const);
class procedure TJSONData.DoError(const Fmt: String; Const Args: array of const);
begin
Raise EJSON.CreateFmt(Fmt,Args);
end;

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

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>

19
packages/fcl-json/tests/testjsondata.pp
View File

@ -989,13 +989,20 @@ end;
{ TTestJSON }
procedure TTestJSON.SetDefaultInstanceTypes;
Const
DefJSONInstanceTypes :
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TJSONIntegerNumber,
TJSONInt64Number,TJSONFloatNumber, TJSONString, TJSONBoolean, TJSONNull, TJSONArray,
TJSONObject);
Const
MyJSONInstanceTypes :
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
TMyInt64,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
TMyObject);
procedure TTestJSON.SetDefaultInstanceTypes;
Var
Ti : TJSONInstanceType;
@ -1005,17 +1012,13 @@ begin
end;
procedure TTestJSON.SetMyInstanceTypes;
Const
MyJSONInstanceTypes :
Array [TJSONInstanceType] of TJSONDataClass = (TJSONData, TMyInteger,
TMyInt64,TMyFloat, TMyString, TMyBoolean, TMyNull, TMyArray,
TMyObject);
Var
Ti : TJSONInstanceType;
begin
For ti:=Low(TJSONInstanceType) to High(TJSONInstanceType) do
SetJSONInstanceType(Ti,MyJSONInstanceTypes[ti]);
AssertEquals('Previous value is returned by SetJSONInstanceType',DefJSONInstanceTypes[ti],SetJSONInstanceType(Ti,MyJSONInstanceTypes[ti]));
end;
procedure TTestJSON.SetUp;

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

@ -406,7 +406,7 @@ Var
begin
H:=GetJSONParserHandler;
try
SetJSONParserHandler(Nil);
AssertSame('SetJSONParserHandler returns previous handler',H,SetJSONParserHandler(Nil));
AssertException('No handler raises exception',EJSON,@CallNoHandler);
AssertException('No handler raises exception',EJSON,@CallNoHandlerStream);
finally