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

* Patches for bugs 16815 and 16807 (double type and access violation when accessing non-existent member

Browse Source 
git-svn-id: trunk@15495 -
This commit is contained in:
michael 2010-06-30 10:35:04 +00:00
parent f72526b95f
commit 0a4e4d3c62
3 changed files with 30 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -27,7 +27,7 @@ uses
type
TJSONtype = (jtUnknown, jtNumber, jtString, jtBoolean, jtNull, jtArray, jtObject);
TJSONFloat = Extended;
TJSONFloat = Double;
TJSONStringType = AnsiString;
TJSONCharType = AnsiChar;
PJSONCharType = ^TJSONCharType;
@ -422,7 +422,7 @@ Resourcestring
SErrPointerNotNil = 'Cannot add non-nil pointer to JSON%s';
SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
SErrNonexistentElement = 'Unknown object member: "%s"';
Function StringToJSONString(S : TJSONStringType) : TJSONStringType;
@ -1473,6 +1473,8 @@ end;
function TJSONObject.GetElements(AName: string): TJSONData;
begin
Result:=TJSONData(FHash.Find(AName));
If (Result=Nil) then
Raise EJSON.CreateFmt(SErrNonexistentElement,[AName]);
end;
function TJSONObject.GetFloats(AName : String): TJSONFloat;

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

@ -157,6 +157,7 @@ type
TTestObject = class(TTestJSON)
private
procedure TestAddBoolean(B : Boolean);
Procedure TestAccessError;
published
Procedure TestCreate;
Procedure TestCreateString;
@ -184,6 +185,7 @@ type
procedure TestRemove;
procedure TestClone;
procedure TestExtract;
Procedure TestNonExistingAccessError;
end;
@ -998,7 +1000,7 @@ end;
procedure TTestArray.TestCreateFloat;
Const
S = 1.2;
S : double = 1.2;
Var
J : TJSONArray;
@ -1564,6 +1566,20 @@ begin
end;
procedure TTestObject.TestAccessError;
Var
J : TJSONObject;
begin
J:=TJSonObject.Create;
try
J.Strings['NonExist'];
finally
FreeAndNil(J);
end;
end;
procedure TTestObject.TestAddBooleanTrue;
begin
@ -1812,6 +1828,11 @@ begin
end;
procedure TTestObject.TestNonExistingAccessError;
begin
AssertException(EJSON,@TestAccessError);
end;
procedure TTestObject.TestCreateString;
@ -1907,7 +1928,7 @@ procedure TTestObject.TestCreateFloat;
Const
A = 'A';
S = 1.2;
S : double = 1.2;
Var
J : TJSONObject;

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

@ -209,9 +209,9 @@ begin
DoTestArray('[1234567890123456]',1);
DoTestArray('[1234567890123456, 2234567890123456]',2);
DoTestArray('[1234567890123456, 2234567890123456, 3234567890123456]',3);
Str(1.2,S1);
Str(2.3,S2);
Str(3.4,S3);
Str(Double(1.2),S1);
Str(Double(2.3),S2);
Str(Double(3.4),S3);
DoTestArray('['+S1+']',1);
DoTestArray('['+S1+', '+S2+']',2);
DoTestArray('['+S1+', '+S2+', '+S3+']',3);