GitHub-Mirror
/
DelphiLua
mirror of
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Added support for CFunctions in tables 

Example for issue #2
This commit is contained in:
Mark van Renswoude 2020-07-11 09:38:25 +02:00
parent 745c8b5a35
commit 31e205288f
2 changed files with 146 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
Lua.pas
View File

@ -46,14 +46,20 @@ type
TLuaLibraries = set of TLuaLibrary;
TLuaDataType = (LuaNone, LuaNil, LuaNumber, LuaBoolean, LuaString, LuaTable,
LuaFunction, LuaUserData, LuaThread, LuaLightUserData);
LuaFunction, LuaUserData, LuaThread, LuaLightUserData, LuaCClosure);
TLuaVariableType = (VariableNone, VariableBoolean, VariableInteger,
VariableNumber, VariableUserData, VariableString,
VariableTable, VariableFunction);
VariableTable, VariableFunction, VariableCFunction);
ILuaTable = interface;
ILuaFunction = interface;
ILuaContext = interface;
TLuaCFunction = reference to procedure(Context: ILuaContext);
TLuaCMethod = procedure(Context: ILuaContext) of object;
TLuaPushFunction = reference to procedure(AFunction: TLuaCFunction);
ILuaVariable = interface
@ -68,6 +74,7 @@ type
function GetAsString: string;
function GetAsTable: ILuaTable;
function GetAsFunction: ILuaFunction;
function GetAsCFunction: TLuaCFunction;
procedure SetAsBoolean(ABoolean: Boolean);
procedure SetAsInteger(AInteger: Integer);
@ -86,6 +93,7 @@ type
property AsString: string read GetAsString write SetAsString;
property AsTable: ILuaTable read GetAsTable write SetAsTable;
property AsFunction: ILuaFunction read GetAsFunction;
property AsCFunction: TLuaCFunction read GetAsCFunction;
end;
@ -99,6 +107,8 @@ type
class operator Implicit(AValue: Pointer): TLuaImplicitVariable;
class operator Implicit(const AValue: string): TLuaImplicitVariable;
class operator Implicit(AValue: ILuaTable): TLuaImplicitVariable;
class operator Implicit(AValue: TLuaCFunction): TLuaImplicitVariable;
class operator Implicit(AValue: TLuaImplicitVariable): ILuaVariable;
class operator Implicit(AValue: TLuaImplicitVariable): Boolean;
class operator Implicit(AValue: TLuaImplicitVariable): Integer;
@ -223,6 +233,7 @@ type
function GetAsString: string;
function GetAsTable: ILuaTable;
function GetAsFunction: ILuaFunction;
function GetAsCFunction: TLuaCFunction;
procedure SetAsBoolean(ABoolean: Boolean);
procedure SetAsInteger(AInteger: Integer);
@ -278,11 +289,6 @@ type
end;
TLuaCFunction = reference to procedure(Context: ILuaContext);
TLuaCMethod = procedure(Context: ILuaContext) of object;
TLuaPushFunction = reference to procedure(AFunction: TLuaCFunction);
TCustomLuaRegistration = class(TObject)
private
FName: string;
@ -435,6 +441,7 @@ type
class procedure PushVariable(AState: lua_State; AVariable: ILuaVariable; AVariableType: TLuaVariableType); overload;
class procedure PushString(AState: lua_State; const AValue: string);
class procedure PushTable(AState: lua_State; ATable: ILuaTable);
class procedure PushCFunction(AState: lua_State; AClosure: TLuaCFunction);
class function AllocLuaString(const AValue: string): PAnsiChar;
class procedure FreeLuaString(AValue: PAnsiChar);
@ -509,6 +516,7 @@ type
function GetAsString: string;
function GetAsTable: ILuaTable;
function GetAsFunction: ILuaFunction;
function GetAsCFunction: TLuaCFunction;
procedure SetAsBoolean(ABoolean: Boolean);
procedure SetAsInteger(AInteger: Integer);
@ -542,6 +550,7 @@ type
FStringValue: string;
FTableValue: ILuaTable;
FFunctionValue: ILuaFunction;
FCFunctionValue: TLuaCFunction;
protected
property VariableType: TLuaVariableType read FVariableType write FVariableType;
property DataType: TLuaDataType read FDataType write FDataType;
@ -552,6 +561,7 @@ type
property StringValue: string read FStringValue write FStringValue;
property TableValue: ILuaTable read FTableValue write FTableValue;
property FunctionValue: ILuaFunction read FFunctionValue write FFunctionValue;
property CFunctionValue: TLuaCFunction read FCFunctionValue write FCFunctionValue;
public
constructor Create; overload;
constructor Create(ABoolean: Boolean); overload;
@ -561,6 +571,7 @@ type
constructor Create(const AString: string); overload;
constructor Create(ATable: ILuaTable); overload;
constructor Create(AFunction: ILuaFunction); overload;
constructor Create(AFunction: TLuaCFunction); overload;
{ ILuaParameter }
function GetVariableType: TLuaVariableType;
@ -573,6 +584,7 @@ type
function GetAsString: string;
function GetAsTable: ILuaTable;
function GetAsFunction: ILuaFunction;
function GetAsCFunction: TLuaCFunction;
procedure SetAsBoolean(ABoolean: Boolean);
procedure SetAsInteger(AInteger: Integer);
@ -679,6 +691,7 @@ begin
LuaFunction: Result := VariableFunction;
LuaUserData: Result := VariableUserData;
LuaLightUserData: Result := VariableUserData;
LuaCClosure: Result := VariableCFunction;
else
Result := VariableNone;
end;
@ -752,6 +765,7 @@ begin
VariableString: PushString(AState, AVariable.AsString);
VariableTable: PushTable(AState, AVariable.AsTable);
VariableCFunction: PushCFunction(AState, AVariable.AsCFunction);
else
raise ELuaUnsupportedVariableException.CreateFmt('Variable type not supported: %d', [Ord(AVariableType)]);
end;
@ -788,6 +802,43 @@ begin
end;
function LuaWrapperClosure(L: lua_State): Integer; cdecl;
var
method: TMethod;
closure: TLuaCFunction absolute method;
context: ILuaContext;
begin
method.Code := lua_touserdata(L, lua_upvalueindex(1));
method.Data := lua_touserdata(L, lua_upvalueindex(2));
context := TLuaContext.Create(L);
try
closure(context);
Result := context.Result.Count;
except
on E:Exception do
Result := luaL_error(L, PAnsiChar(AnsiString(E.Message)), nil);
end;
end;
class procedure TLuaHelpers.PushCFunction(AState: lua_State; AClosure: TLuaCFunction);
var
method: TMethod absolute AClosure;
begin
{ Assume the reference to AClosure is being kept alive by the caller for as long
as it's needed, for example by the ILuaVariable that contains it. That way we
don't need to keep our own reference, as we can't determine when it's ok to go out
of scope, which would result in memory increase on every use. }
lua_pushlightuserdata(AState, method.Code);
lua_pushlightuserdata(AState, method.Data);
lua_pushcclosure(AState, @LuaWrapperClosure, 2);
end;
// Casting strings directly to PAnsiChar (via AnsiString) causes corruption
// with table values, at least in Delphi XE2. Can't really explain why, seems
// the input string goes out of scope, so let's just go through the motions
@ -929,6 +980,11 @@ begin
Result.Variable := TLuaVariable.Create(AValue);
end;
class operator TLuaImplicitVariable.Implicit(AValue: TLuaCFunction): TLuaImplicitVariable;
begin
Result.Variable := TLuaVariable.Create(AValue);
end;
class operator TLuaImplicitVariable.Implicit(AValue: TLuaImplicitVariable): ILuaVariable;
begin
@ -1856,6 +1912,12 @@ begin
end;
function TCustomLuaParameters.GetAsCFunction: TLuaCFunction;
begin
Result := GetDefaultVariable.GetAsCFunction;
end;
procedure TCustomLuaParameters.SetAsBoolean(ABoolean: Boolean);
begin
GetDefaultVariable.SetAsBoolean(ABoolean);
@ -1910,7 +1972,7 @@ begin
end;
{ TLuaCFunctionParameters }
{ TLuaStackParameters }
constructor TLuaStackParameters.Create(AState: lua_State; ACount: Integer);
begin
inherited Create;
@ -1938,7 +2000,7 @@ begin
end;
{ TLuaCFunctionParameter }
{ TLuaStackVariable }
constructor TLuaStackVariable.Create(AState: lua_State; AIndex: Integer);
begin
inherited Create;
@ -1993,7 +2055,7 @@ end;
function TLuaStackVariable.GetAsTable: ILuaTable;
begin
if not lua_istable(State, Index) then
Result := nil;
Exit(nil);
if not Assigned(FTable) then
FTable := TLuaCachedTable.Create(State, Index);
@ -2005,12 +2067,18 @@ end;
function TLuaStackVariable.GetAsFunction: ILuaFunction;
begin
if not lua_isfunction(State, Index) then
Result := nil;
Exit(nil);
Result := TLuaFunction.Create(State, Index);
end;
function TLuaStackVariable.GetAsCFunction: TLuaCFunction;
begin
raise ELuaUnsupportedVariableException.Create('Can not read stack variables as TLuaCFunction');
end;
procedure TLuaStackVariable.SetAsBoolean(ABoolean: Boolean);
begin
lua_pushboolean(State, IfThen(ABoolean, 1, 0));
@ -2152,6 +2220,15 @@ begin
end;
constructor TLuaVariable.Create(AFunction: TLuaCFunction);
begin
Create;
VariableType := VariableCFunction;
DataType := LuaCClosure;
CFunctionValue := AFunction;
end;
function TLuaVariable.GetVariableType: TLuaVariableType;
begin
Result := VariableType;
@ -2206,6 +2283,12 @@ begin
end;
function TLuaVariable.GetAsCFunction: TLuaCFunction;
begin
Result := CFunctionValue;
end;
procedure TLuaVariable.SetAsBoolean(ABoolean: Boolean);
begin
VariableType := VariableBoolean;
@ -2477,7 +2560,7 @@ begin
end;
{ TLuaCFunction }
{ TLuaFunction }
constructor TLuaFunction.Create(AState: lua_State; AIndex: Integer);
var
actualIndex: Integer;

51
UnitTests/source/TestWrapper.pas
View File

@ -46,6 +46,8 @@ type
procedure TableOutput;
procedure TableDelphiFunction;
procedure TableLuaFunction;
procedure TableInTable;
procedure CFunctionInNestedTable;
procedure VariableFunction;
procedure ByteCode;
@ -386,6 +388,55 @@ begin
end;
procedure TTestWrapper.TableInTable;
var
inner: ILuaTable;
outer: ILuaTable;
begin
inner := TLuaTable.Create;
inner.SetValue('text', 'Hello from the inner table!');
outer := TLuaTable.Create;
outer.SetValue('inner', inner);
Lua.LoadFromString('print(outer.inner.text)', False);
Lua.SetGlobalVariable('outer', outer);
Lua.Run;
CheckEquals('Hello from the inner table!', Printed.ToString);
end;
{ The fact that it's in a nested table shouldn't matter for registering functions
in tables, but it demonstrates https://github.com/MvRens/DelphiLua/issues/2 }
procedure TTestWrapper.CFunctionInNestedTable;
var
inner: ILuaTable;
outer: ILuaTable;
output: string;
begin
output := '';
inner := TLuaTable.Create;
inner.SetValue('go',
procedure(Context: ILuaContext)
begin
output := Context.Parameters[0].AsString;
end);
outer := TLuaTable.Create;
outer.SetValue('inner', inner);
Lua.LoadFromString('outer.inner.go(''Hello inner function!'')', False);
Lua.SetGlobalVariable('outer', outer);
Lua.Run;
CheckEquals('Hello inner function!', output);
end;
procedure TTestWrapper.VariableFunction;
var
functions: ILuaTable;