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

git-svn-id: trunk@15495 -

packages/fcl-json/src/fpjson.pp

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

packages/fcl-json/tests/testjsondata.pp

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

packages/fcl-json/tests/testjsonparser.pp

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