When using TJson.JsonToObject in a multi-thread environment random access violations occur. I was searching a long time for the problem and I could isolate it with the following code
JSON class
type
TParameter = class
public
FName : string;
FDataType : string;
FValue : string;
end;
Testfunction:
procedure Test();
var
myTasks: array of ITask;
i : integer;
max : integer;
begin
max := 50;
SetLength(myTasks, max);
for i := 0 to max -1 do begin
myTasks[i] := TTask.Create(procedure ()
var
json : string;
p : TParameter;
begin
json := '{"name":"NameOfParam","dataType":"TypeOfParam","value":"ValueOfParam"}';
p := TJson.JsonToObject<TParameter>(json);
p.Free;
end);
myTasks[i].Start;
end;
TTask.WaitForAll(myTasks);
ShowMessage('all done!');
end;
It's only a code snippet based of a much more complex source. As long I use this code in a single thread everything works without a problem. I'm wondering if there is anything wrong with the code.
The method TJSONUnMarshal.ObjectInstance in REST.JsonReflect.pas has a severe bug:
It calls FreeAndNil on a TRttiType instance. This should never be done because all TRtti*** instances are managed by the TRttiContext.
After I removed the FreeAndNil call I could not reproduce the access violation anymore.
Reported as: https://quality.embarcadero.com/browse/RSP-10035
P.S. I also think that https://quality.embarcadero.com/browse/RSP-9815 will affect your code.
Related
I am trying to convert Json trying to class object, but the values are not appearing in the new object variable. The resulting object has blank value in string and 0 in integer.
Thanks in advance.
Code:
type
Student =class
public
Name : string;
Age : Integer;
end;
procedure TForm2.Button5Click(Sender: TObject);
var
Student1, Student2: Student;
STR: string;
begin
Student1 := Student.Create;
Student2 := Student.Create;
try
Student1.Name := 'Sam';
Student1.Age := 24;
str := TJson.ObjectToJsonString(Student1);
Form2.outputMemo.Lines.Add(str);
Student2 := TJSON.JsonToObject<Student>(str);
Form2.outputMemo.Lines.Add(Student2.Name);
Form2.outputMemo.Lines.Add(Student2.Age.ToString);
finally
Student1.Free;
Student2.Free;
end;
//Form2.outputMemo.Lines.Text :=TJson.ObjectToJsonObject(Student1);
end;
Output:
{"name":"Sam","age":24}
0
Edit:
I just saw this, and it worked when I changed the names to FName and FAge... what a sorcery!, can anyone please explain the logic behind this?
Delphi Rest.JSON JsonToObject only works with f variables
The internal mapping of JSON fields to Delphi fields is prefixing them with F and changing the following character to upper case. If you want complete control over this you can specify the JSON name with an attribute:
type
Student =class
public
[JSONName('name')]
Name : string;
[JSONName('age')]
Age : Integer;
end;
Note that the JSON names given are case sensitive.
You need to include REST.Json.Types to the uses so that the attribute declaration can be found.
Here's the case:
uses
System.JSON;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
dd:Double;
aJsonObj:TJSONObject;
begin
dd := 100.0;
aJsonObj := TJSONObject.Create(TJSONPair.Create('DecimalValue',TJSONNumber.Create(dd)));
ShowMessage(aJsonObj.ToString);
end;
which shows
{"DecimalValue":100}
What I need is
{"DecimalValue":100.0}
I've tried to change JsonFormatSettings but I couldn't find a way to add the fractional part.
One of TJSONNumber constructors accepts a raw string value that will be used in resulting JSON string without further processing. It allows you to pre-format the value yourself:
procedure TForm1.Button1Click(Sender: TObject);
var
dd: Double;
aJsonObj: TJSONObject;
begin
dd := 100.0;
aJsonObj := TJSONObject.Create(
TJSONPair.Create('DecimalValue', TJSONNumber.Create(FormatFloat('0.0###', dd, GetJSONFormat))));
try
ShowMessage(aJsonObj.ToString);
finally
aJsonObj.Free;
end;
end;
Using the above snippet the value shows as:
{"DecimalValue":100.0}
You can even create 'whatever' as number:
aJsonObj := TJSONObject.Create(TJSONPair.Create('DecimalValue', TJSONNumber.Create('whatever')));
to get this (invalid) JSON:
{"DecimalValue":whatever}
Side note: you are responsible for releasing root JSON objects you create as they have no parent object to manage their lifetime. Use try..finally to Free the root object when you're done with it as you can see in the first code snippet. Too bad that the documentation itself tempts you not to cleanup.
I have this problem.
Im at the End of this Function:
FUNCTION ToString(Liste : Pokemon) : String;
VAR
RES : STRING;
BEGIN
ClrScr;
TextBackground(Green);
Writeln('DER POKEDEX:');
Writeln;
WHILE (Liste <> NIL) DO
BEGIN
RES := RES + Concat('#',IntToStr(Liste^.PkmnPos), ': ', Liste^.PkmnName, '. // ', IntToStr(Liste^.PkmnKG), ' kg', chr(13),chr(10),chr(13),chr(10));
Liste := Liste^.Next;
END;
TextBackground(Black);
ToString := Res;
END;
Now, I have the Procedure called "Submenu". So, when in the Main Program code, i can just call the procedure "Submenu()". But when im within this above functions, it wont compile my code. It says "identifier not found". But, after im done with this function the last thing it needs to do is go into submenu. And im really trying not to builed an infinite loop in wihtin the main program only to not have the programm end. What is the best way of doing that?
O, and I know, that if I have the function Submenu started before the other functions, it would work. But both functions call each other, so neither can be on top of each other because there will always be one, that wont work...
Regards.
Then you need a forward declaration:
FUNCTION ToString(Liste : Pokemon) : String; FORWARD;
FUNCTION Submenu();
BEGIN
..
ToString(Liste);
..
END;
FUNCTION ToString(Liste : Pokemon) : String;
BEGIN
// real implementation tostring
..
Submenu();
..
END;
Note the declaration with FORWARD
What is the cause of (apparently) spurious warnings when compiling local functions of anonymous functions, and how do I eliminate them.
A simple function compiles clean - no warnings. If the function is a local function of another function, again there are no warnings. If the function is a local function of an anonymous function it gives rise to the following warnings:
[DCC Warning] Unit1.pas(57): W1036 Variable 'i' might not have been initialized
[DCC Warning] Unit1.pas(58): W1035 Return value of function 'StrToJType' might be undefined
Example code is set out below. Please note that though this code compiles, it gives warnings unrelated to this question because it is incomplete.
EDIT
Comments and responses suggest that the fact that the example code contains no return value in the anonymous function may be the cause of the problem. This edit amends the code to remedy this, to simplify the local function case, and to minimise the code. The problem is still the same.
unit Unit1;
interface
type
JType = (JAtLeastOnce, JConditionLine, JInfix, JIteration, JNonNullInfix );
TFuncTest = reference to function : JType;
function StrToJType(aString : string) : JType;
implementation
function StrToJType(aString : string) : JType;
// Basic function - does not give warnings
var
i : integer;
begin
i := Pos(aString, '+i*-?');
if i <> 0 then result := JType(i - 1) else result := High(JType);
end;
function Test : JType;
// Local function - does not give warnings
function StrToJType(aString : string) : JType;
var
i : integer;
begin
i := Pos(aString, '+i*-?');
if i <> 0 then result := JType(i - 1) else result := High(JType);
end;
begin
result := low(JType);
end;
function Test2 : TFuncTest;
// Local function of anonymous function - gives warnings
begin
result :=
function : JType
function StrToJType(aString : string) : JType;
var
i : integer;
begin
i := Pos(aString, '+i*-?');
if i <> 0 then result := JType(i - 1) else result := High(JType);
end;
begin
result := Low(JType);
end;
end;
end.
Your anonymous function does not assign its return value.
function Test2 : TFuncTest;
// Local function of anonymous function - gives warnings
begin
result :=
function : JStructureType
function StrToJType(aString : string) : JStructureType;
const
c : string = '+i*-?p!qoxsc<^>8|';
var
i : integer;
begin
i := Pos(aString, c);
if (aString <> '') and (i <> 0) then result := JStructureType(i - 1)
else result := High(JStructureType);
end;
begin
// need to return something here
end;
end;
The compiler should also object to you making the same mistake in Test.
If the compiler really is complaining about StrToJType after you've fixed all the other errors, that would be a compiler bug and should be submitted to Quality Portal.
Update
Your edit confirms that the warnings in the local function remain when you resolve the other mistakes. So this would appear to be a compiler bug. Please make a minimal reproduction and submit it.
Of course Delphi XE won't be updated in the future. Unless this bug still exists in XE8 there's probably no point in reporting a bug.
One might suspect that the compiler is confused by a local function, local to an anonymous method, that is never called
I'm trying to catch the following JSON array :
[{"name":"Bryan","email":"Bryan#hotmail.com"},
{"name":"Louis","email":"Louis#hotmail.com"},
{"name":"Maria","email":"Maria#hotmail.com"},
{"name":"Test","email":"test#hotmail.com"},
{"name":"Anthony","email":"anthony#hotmail.com"}]
and put it in Memo or ListBox in Delphi :
the code is the following :
procedure TForm1.Button1Click(Sender: TObject);
var jv: TJSONValue;
jo: TJSONObject;
jp: TJSONPair;
ja: TJSONArray;
i: integer;
j: integer;
begin
RESTRequest1.Execute;
jv:=RESTResponse1.JSONValue;
jo:= TJSONObject.ParseJSONValue(jv.ToString) as TJSONObject;
try
for i := 0 to jo.Size - 1 do
begin
jp := jo.Get(i);
if jp.JsonValue is TJSONArray then
begin
ja := jp.JsonValue as TJSONArray;
for j := 0 to ja.Size -1 do
Memo1.Lines.Add(ja.Get(i).ClassName + ': ' + ja.Get(j).ToString);
end
else
Memo1.Lines.Add(jp.ClassName + ': '+ jp.ToString);
end;
finally
jo.Free;
end;
end;
When I click in Button I got the following error message :
Invalid class typecast
during debugging the following line has a problem :
jo:= TJSONObject.ParseJSONValue(jv.ToString) as TJSONObject;
I don't know how to resolve this problem or this mistake ,
Could you please help me ?
Thanks.
This could perfectly well be worked out by reading the code and looking at the JSON. However, I'd like to show you how to go about debugging such a problem in case you cannot work it out by static analysis. When an as cast fails that is always because the object on the left hand side of the as does not derive from the type on the right hand side. The next step then is always to inquire as to what the type of the object on the left hand side is. I've included a short MCVE above as a means to demonstrate.
The output of this program:
{$APPTYPE CONSOLE}
uses
System.JSON;
const
JSON = '[{"name":"Bryan","email":"Bryan#hotmail.com"},' +
' {"name":"Louis","email":"Louis#hotmail.com"},' +
' {"name":"Maria","email":"Maria#hotmail.com"},' +
' {"name":"Test","email":"test#hotmail.com"},' +
' {"name":"Anthony","email":"anthony#hotmail.com"}]';
begin
Writeln(TJSONObject.ParseJSONValue(JSON).ClassName);
end.
is
TJSONArray
Now, TJSONArray does not derive from TJSONObject. Hence your as cast raise a runtime error. If you cast the value returned by ParseJSONValue to TJSONArray that will succeed.
This is to be expected since the root of your JSON is an array and is not an object.
You need to modify your code so that it does not assume that the root level is always an object. You need different behaviour for arrays and objects.
I'm not sure what the problem of TJSONObject is with the string you posted.
For some reason it will parse it if you changed it.
{"Persons":[{"name":"Bryan","email":"Bryan#hotmail.com"},{"name":"Louis","email":"Louis#hotmail.com"},{"name":"Maria","email":"Maria#hotmail.com"},{"name":"Test","email":"test#hotmail.com"},{"name":"Anthony","email":"anthony#hotmail.com"}]}
If I run the code as it is I get the following result
If you don't mind using something different than default Delphi units I would suggest superobject (Link here)
superobject will parse your JSON edited and as posted.
Your code would look like this:
Const
MyJSON = '[{"name":"Bryan","email":"Bryan#hotmail.com"},{"name":"Louis","email":"Louis#hotmail.com"},{"name":"Maria","email":"Maria#hotmail.com"},{"name":"Test","email":"test#hotmail.com"},{"name":"Anthony","email":"anthony#hotmail.com"}]';
procedure ParseJSON;
var
obj: ISuperObject;
Ar: TSuperArray;
I: integer;
begin
obj := SO(MyJSON);
if obj.IsType(stArray) then
begin
Ar := obj.AsArray;
try
for I := 0 to Ar.Length-1 do
L.Add(Ar.O[I].AsString);
finally
Ar.Free;
end;
end
else
L.Add(Obj.AsString);
end;
Result:
For Koul, to get the element names and values.
Like I said not very pretty code but ok.
Ar.O[0].AsObject.GetNames.AsArray.S[0]
To cut it up in pieces a bit.
Ar.O[0] //Get the first element in the array as ISuperObject
.AsObject //Get it as TSuperTableString
.GetNames //Gets all names in the array, in this case "name" and "email"
.AsArray[0]//Get the first name in the names array.
It will result in email (Names are sorted A-Z)
You can do the same for the values by calling GetValues instead of GetNames.
I think the prettiest way to get it will be defining 2x more TSuperArray
procedure PrintNamesAndValues;
Var
Ar, ArNames, ArValues:TSuperArray;
I: Integer;
begin
Ar := SO(<JSON string>).asArray;
ArNames := Ar.O[0].AsObject.GetNames.AsArray;
ArValues := Ar.O[0].AsObject.GetValues.AsArray;
For I := 0 to ArNames.Length-1 do
WriteLn(Format('%s: %s',[ArNames.S[I], ArValues.S[I]]));
end;
Hope it's all clear enough :)