Access Violation if RTTI is accessed inside package - delphi

Question

I wrote a simple console program to cast some RTTI magic:
program TypeCast;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.RTTI, Generics.Collections;
type
TSpr = class
public
s: string;
i: Integer;
b: Boolean;
end;
var
Spr: TSpr;
vCtx: TRTTIContext;
vType: TRTTIType;
vField: TRTTIField;
Dict: TDictionary<string, TRTTIField>;
begin
try
Spr := TSpr.Create;
vType := vCtx.GetType(TSpr.ClassInfo);
Dict := TDictionary<string, TRTTIField>.Create;
for vField in vType.GetFields do
Dict.AddOrSetValue(vField.Name, vField);
Dict['s'].SetValue(Spr, 'Hello World!');
Dict['i'].SetValue(Spr, 123);
Dict['b'].SetValue(Spr, True);
Writeln(Spr.s);
Writeln(Spr.i);
Writeln(Spr.b);
Spr.Free;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
Output:
Hello World!
123
TRUE
If I compile and run this program, it works fine. But if I use such technique to forward variables of these types to object, defined in another package, it gets me into lot of troubles.
MCVE stuff / Steps To Reproduce:
...assuming you are starting from empty environment...
Create PluginInterface package. Add there UClassManager
unit UClassManager;
interface
uses
Classes, Contnrs;
type
TClassManager = class(TClassList);
function ClassManager: TClassManager;
implementation
var
Manager: TClassManager;
function ClassManager: TClassManager;
begin
Result := Manager;
end;
initialization
Manager := TClassManager.Create;
finalization
Manager.Free;
end.
and UPlugin units.
unit UPlugin;
interface
uses RTTI;
type
TPlugin = class
public
procedure Init; virtual; abstract;
function SetProp(Key: string; Value: TValue): Boolean; virtual; abstract;
end;
TPluginClass = class of TPlugin;
IPluginHost = interface
function RunPlugin(PluginName: string): TPlugin; // Run Plugin by it's ClassName
end;
var
Host: IPluginHost;
implementation
end.
Create VCL Forms Application, enable runtime packages, add reference to PluginInterface and add TButton onto it. Make these handlers for corresponding events:
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadPackage('UniversalSpr.bpl');
Host := Self;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Plugin: TPlugin;
begin
Plugin := Host.RunPlugin('TSprPlugin');
Plugin.Init;
Plugin.SetProp('SprTableName', 'MATERIALS');
Plugin.SetProp('EditRights', True);
Plugin.SetProp('BeforePostValue1', 3);
end;
function TForm1.RunPlugin(PluginName: string): TPlugin;
var
I: Integer;
begin
Result := nil;
for I := 0 to ClassManager.Count - 1 do
if ClassManager[I].ClassNameIs(PluginName) then begin
Result := TPluginClass(ClassManager[I]).Create;
Break;
end;
end;
Of coarse, TForm1 should be descendant of IPluginHost. And don't forget to add UClassManager and UPlugin into uses clause. Other units will be added automatically by IDE.
Create package UniversalSpr and place it's output file into the same directory where your application is placed. Implement UPlugin inside TSprPlugin:
unit USprPlugin;
interface
uses
UPlugin, RTTI, Generics.Collections;
type
TSpr = class
SprTableName: string;
BeforePostValue1: int64;
EditRights: boolean;
end;
TSprPlugin = class(TPlugin)
procedure Init; override;
function SetProp(Key: string; Value: TValue): Boolean; override;
private
Spr: TSpr;
PropDict: TDictionary<string, TRTTIField>;
end;
implementation
procedure TSprPlugin.Init;
var
vCtx: TRTTIContext;
vType: TRTTIType;
vField: TRTTIField;
begin
if not Assigned(Spr) then
Spr := TSpr.Create;
vType := vCtx.GetType(Spr.ClassInfo);
if not Assigned(PropDict) then
PropDict := TDictionary<string, TRTTIField>.Create;
for vField in vType.GetFields do
PropDict.Add(vField.Name, vField);
end;
function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
Field: TRTTIField;
begin
Result := PropDict.TryGetValue(Key, Field);
if Result then
// here I get Access Violation
Field.SetValue(Spr, Value);
end;
end.
After you click Button1, you can pass specified values into properties setter/mutator, but if you try to repeat my TypeCast trick inside the routine, you'll get Access Violation trying to access 00000004.
Also, investigation and advanced debugging shows that Field.FieldType evaluates correctly (which explains why InsufficientRTTI is not thrown), but if I want to get Field.Fieldtype.Handle, I get the infamous AV.
I can set the value just skipping Cast from original SetValue method:
function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
Field: TRTTIField;
begin
Result := PropDict.TryGetValue(Key, Field);
if Result then
Value.ExtractRawData(PByte(Spr) + Field.Offset);
end;
Dalija recommended to avoid packages, I already took this into accout, that's why I created TypeCast to test RTTI. But I need packages, because of design of my application, I cannot just rewrite it to be monolythic. What can I do to avoid this Access Violation without abandoning packages?

Answer 1

Your current code has some issues regardless whether you use runtime packages or not. Your MCVE is not exactly minimal, and you have added too many steps from your working console application to your packaged code that does not work.
In debugging your issue you should have started from encapsulating logic into TSprPlugin class and testing that class directly without messing with runtime packages. When you are sure that TSprPlugin code functions properly, then you can add packages and see how it goes.
Right now your code fails with following simple test project
program test;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
USprPlugin in 'USprPlugin.pas',
UPlugin in 'UPlugin.pas';
var
Plugin: TPlugin;
begin
Plugin := TSprPlugin.Create;
Plugin.Init;
Plugin.SetProp('SprTableName', 'MATERIALS');
Plugin.SetProp('EditRights', True);
Plugin.SetProp('BeforePostValue1', 3);
end.
Moving vCtx from local variable to TSprPlugin field solves the issue for above test case.
unit USprPlugin;
interface
uses
UPlugin, RTTI, UniversalSprUnit, Generics.Collections;
type
TSprPlugin = class(TPlugin)
vCtx: TRTTIContext;
procedure Init; override;
function SetProp(Key: string; Value: TValue): Boolean; override;
private
Spr: TSpr;
PropDict: TDictionary<string, TRTTIField>;
end;
implementation
procedure TSprPlugin.Init;
var
vType: TRTTIType;
vField: TRTTIField;
begin
vCtx := TRttiContext.Create;
if not Assigned(Spr) then
Spr := TSpr.Create;
vType := vCtx.GetType(Spr.ClassInfo);
if not Assigned(PropDict) then
PropDict := TDictionary<string, TRTTIField>.Create;
for vField in vType.GetFields do
PropDict.Add(vField.Name, vField);
end;
function TSprPlugin.SetProp(Key: string; Value: TValue): Boolean;
var
Field: TRTTIField;
begin
Result := PropDict.TryGetValue(Key, Field);
if Result then
// here I get Access Violation
Field.SetValue(Spr, Value);
end;
end.
Starting from there you can add up additional functionality step by step ensuring that each step didn't break functionality.
Also, you are not releasing Spr and PropDict fields thus creating memory leak, but I am not sure if that code is not included just because it is not directly connected with issues you are having, or you are really having memory leak there.