From 0a4e4d3c621b42643d9df6c89f841c273a703329 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Wed, 30 Jun 2010 10:35:04 +0000
Subject: [PATCH] * 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           |  6 ++++--
 packages/fcl-json/tests/testjsondata.pp   | 25 +++++++++++++++++++++--
 packages/fcl-json/tests/testjsonparser.pp |  6 +++---
 3 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/packages/fcl-json/src/fpjson.pp b/packages/fcl-json/src/fpjson.pp
index caf6ac678b..7fb93cf24d 100644
--- a/packages/fcl-json/src/fpjson.pp
+++ b/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;
diff --git a/packages/fcl-json/tests/testjsondata.pp b/packages/fcl-json/tests/testjsondata.pp
index cfc189561f..3e7fbe3a90 100644
--- a/packages/fcl-json/tests/testjsondata.pp
+++ b/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;
diff --git a/packages/fcl-json/tests/testjsonparser.pp b/packages/fcl-json/tests/testjsonparser.pp
index 46b1579b61..3542e212d9 100644
--- a/packages/fcl-json/tests/testjsonparser.pp
+++ b/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);