604 lines
14 KiB
ObjectPascal
604 lines
14 KiB
ObjectPascal
unit TestWrapper;
|
|
|
|
interface
|
|
uses
|
|
System.SysUtils,
|
|
|
|
TestFramework,
|
|
|
|
Lua;
|
|
|
|
|
|
type
|
|
TTestWrapper = class(TTestCase)
|
|
private
|
|
FLua: TLua;
|
|
FPrinted: TStringBuilder;
|
|
protected
|
|
procedure SetUp; override;
|
|
procedure TearDown; override;
|
|
|
|
procedure Print(AContext: ILuaContext);
|
|
|
|
property Lua: TLua read FLua;
|
|
property Printed: TStringBuilder read FPrinted;
|
|
published
|
|
procedure NewState;
|
|
procedure LoadAndRunFromString;
|
|
procedure LoadAndRunFromStream;
|
|
procedure LoadMultiple;
|
|
procedure LoadMultipleSharedVariable;
|
|
procedure ChunkNameInException;
|
|
|
|
procedure Input;
|
|
procedure Output;
|
|
procedure DelphiFunction;
|
|
procedure DelphiFunctionException;
|
|
procedure LuaFunction;
|
|
procedure LuaFunctionDefaultResult;
|
|
procedure LuaFunctionString;
|
|
|
|
procedure TableSetGet;
|
|
procedure TableSetTwice;
|
|
procedure TableSetDifferentTypes;
|
|
|
|
procedure TableInput;
|
|
procedure TableOutput;
|
|
procedure TableDelphiFunction;
|
|
procedure TableLuaFunction;
|
|
procedure TableInTable;
|
|
procedure CFunctionInNestedTable;
|
|
|
|
procedure VariableFunction;
|
|
procedure ByteCode;
|
|
procedure Capture;
|
|
procedure DenyRequire;
|
|
|
|
procedure RegisterObject;
|
|
procedure RegisterObjectTable;
|
|
|
|
procedure LoadFromFile;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
System.Classes,
|
|
System.IOUtils;
|
|
|
|
|
|
type
|
|
TProtectedLua = class(TLua);
|
|
|
|
|
|
TTestObject = class(TPersistent)
|
|
private
|
|
FOutput: TStringBuilder;
|
|
public
|
|
constructor Create(AOutput: TStringBuilder);
|
|
published
|
|
procedure Method1(AContext: ILuaContext);
|
|
procedure Method2(AContext: ILuaContext);
|
|
end;
|
|
|
|
|
|
{ TTestWrapper }
|
|
procedure TTestWrapper.SetUp;
|
|
begin
|
|
inherited;
|
|
|
|
FPrinted := TStringBuilder.Create;
|
|
|
|
FLua := TLua.Create;
|
|
FLua.AutoOpenLibraries := [StringLib];
|
|
FLua.RegisterFunction('print', Print);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TearDown;
|
|
begin
|
|
FreeAndNil(FPrinted);
|
|
FreeAndNil(FLua);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.Print(AContext: ILuaContext);
|
|
begin
|
|
FPrinted.Append(AContext.Parameters.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.NewState;
|
|
begin
|
|
TProtectedLua(Lua).CheckState;
|
|
end;
|
|
|
|
|
|
|
|
procedure TTestWrapper.LoadAndRunFromString;
|
|
begin
|
|
Lua.LoadFromString('print("Hello world!")');
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LoadAndRunFromStream;
|
|
begin
|
|
Lua.LoadFromStream(TStringStream.Create('print("Hello world!")'), soOwned);
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LoadMultiple;
|
|
begin
|
|
Lua.LoadFromString('print "Hello world!"', True, 'Script1');
|
|
Lua.LoadFromString('print "Goodbye world!"', True, 'Script2');
|
|
|
|
CheckEquals('Hello world!Goodbye world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LoadMultipleSharedVariable;
|
|
begin
|
|
Lua.LoadFromString('message = "Hello world!"', True, 'Script1');
|
|
Lua.LoadFromString('print(message)', True, 'Script2');
|
|
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
end;
|
|
|
|
procedure TTestWrapper.Input;
|
|
begin
|
|
Lua.SetGlobalVariable('thingy', 'world');
|
|
Lua.LoadFromString('print("Hello "..thingy.."!")');
|
|
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.Output;
|
|
var
|
|
output: ILuaVariable;
|
|
|
|
begin
|
|
Lua.LoadFromString('output = "Hello world!"');
|
|
|
|
output := lua.GetGlobalVariable('output');
|
|
CheckNotNull(output, 'output is nil');
|
|
CheckEquals('Hello world!', output.AsString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.ChunkNameInException;
|
|
begin
|
|
Lua.LoadFromString('print("This one''s alright")', True, 'Script1');
|
|
|
|
try
|
|
Lua.LoadFromString('print("This one isn''t"', True, 'Script2');
|
|
Fail('ELuaException expected');
|
|
except
|
|
on E:Exception do
|
|
begin
|
|
CheckIs(E, ELuaException);
|
|
CheckEquals('[string "Script2"]:1: '')'' expected near <eof>', E.Message);
|
|
end;
|
|
end;
|
|
|
|
Lua.LoadFromString('print("Fine again!")', True, 'Script3');
|
|
CheckEquals('This one''s alrightFine again!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.DelphiFunction;
|
|
begin
|
|
Lua.RegisterFunction('myuppercase',
|
|
procedure(AContext: ILuaContext)
|
|
begin
|
|
AContext.Result.Push(UpperCase(AContext.Parameters[0].AsString));
|
|
end);
|
|
|
|
Lua.LoadFromString('print(myuppercase("Hello world!"))');
|
|
CheckEquals('HELLO WORLD!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.DelphiFunctionException;
|
|
begin
|
|
Lua.RegisterFunction('crazyharry',
|
|
procedure(AContext: ILuaContext)
|
|
begin
|
|
raise Exception.Create('Boom!');
|
|
end);
|
|
|
|
try
|
|
Lua.LoadFromString('print(crazyharry("Did somebody say dynamite?"))');
|
|
Fail('ELuaNativeCodeException expected');
|
|
except
|
|
on E:Exception do
|
|
begin
|
|
CheckIs(E, ELuaException);
|
|
CheckEquals('[string "?"]:1: Boom!', E.Message);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LuaFunction;
|
|
var
|
|
returnValues: ILuaReadParameters;
|
|
|
|
begin
|
|
Lua.LoadFromString('function sum(a, b)'#13#10 +
|
|
' return a + b'#13#10 +
|
|
'end');
|
|
|
|
returnValues := Lua.Call('sum', [1, 2]);
|
|
CheckEquals(1, returnValues.Count, 'returnValues Count');
|
|
CheckEquals(3, returnValues[0].AsInteger, 'returnValues[0]');
|
|
|
|
returnValues := Lua.Call('sum', [4, 12]);
|
|
CheckEquals(1, returnValues.Count, 'returnValues Count');
|
|
CheckEquals(16, returnValues[0].AsInteger, 'returnValues[0]');
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LuaFunctionDefaultResult;
|
|
var
|
|
returnValues: ILuaReadParameters;
|
|
|
|
begin
|
|
Lua.LoadFromString('function sum(a, b)'#13#10 +
|
|
' return a + b'#13#10 +
|
|
'end');
|
|
|
|
returnValues := Lua.Call('sum', [1, 2]);
|
|
CheckEquals(1, returnValues.Count, 'returnValues Count');
|
|
CheckEquals(3, returnValues.AsInteger, 'returnValues');
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LuaFunctionString;
|
|
var
|
|
returnValues: ILuaReadParameters;
|
|
|
|
begin
|
|
Lua.LoadFromString('function echo(sound)'#13#10 +
|
|
' return string.sub(sound, 2)'#13#10 +
|
|
'end');
|
|
|
|
returnValues := Lua.Call('echo', ['hello?']);
|
|
CheckEquals(1, returnValues.Count, 'returnValues Count');
|
|
CheckEquals('ello?', returnValues[0].AsString, 'returnValues[0]');
|
|
end;
|
|
|
|
procedure TTestWrapper.TableSetGet;
|
|
var
|
|
table: ILuaTable;
|
|
|
|
begin
|
|
table := TLuaTable.Create;
|
|
table.SetValue('key', 'value');
|
|
CheckEquals('value', table.GetValue('key').AsString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableSetTwice;
|
|
var
|
|
table: ILuaTable;
|
|
|
|
begin
|
|
table := TLuaTable.Create;
|
|
table.SetValue('key', 'value');
|
|
table.SetValue('key', 'newvalue');
|
|
CheckEquals('newvalue', table.GetValue('key').AsString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableSetDifferentTypes;
|
|
var
|
|
table: ILuaTable;
|
|
|
|
begin
|
|
// Automatic number conversion is not applicable to table keys in Lua
|
|
table := TLuaTable.Create;
|
|
table.SetValue('1', 'stringValue');
|
|
table.SetValue(1, 'numberValue');
|
|
CheckEquals('stringValue', table.GetValue('1').AsString);
|
|
CheckEquals('numberValue', table.GetValue(1).AsString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableInput;
|
|
var
|
|
input: ILuaTable;
|
|
|
|
begin
|
|
input := TLuaTable.Create;
|
|
input.SetValue('text', 'Hello world!');
|
|
|
|
Lua.LoadFromString('print(message.text)', False);
|
|
Lua.SetGlobalVariable('message', input);
|
|
Lua.Run;
|
|
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableOutput;
|
|
var
|
|
output: ILuaVariable;
|
|
answer: ILuaVariable;
|
|
|
|
begin
|
|
Lua.LoadFromString('output = { answer = 42 }');
|
|
|
|
output := lua.GetGlobalVariable('output');
|
|
CheckNotNull(output, 'output is nil');
|
|
CheckNotNull(output.AsTable, 'output.AsTable is nil');
|
|
|
|
answer := output.AsTable.GetValue('answer');
|
|
CheckNotNull(answer, 'answer is nil');
|
|
CheckEquals(42, answer.AsInteger);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableDelphiFunction;
|
|
begin
|
|
Lua.RegisterFunction('invertTable',
|
|
procedure(AContext: ILuaContext)
|
|
var
|
|
input: ILuaTable;
|
|
output: ILuaTable;
|
|
pair: TLuaKeyValuePair;
|
|
|
|
begin
|
|
input := AContext.Parameters[0].AsTable;
|
|
output := TLuaTable.Create;
|
|
|
|
for pair in input do
|
|
output.SetValue(pair.Value, pair.Key);
|
|
|
|
AContext.Result.Push(output);
|
|
end);
|
|
|
|
Lua.LoadFromString('table = invertTable({ value = "key" })'#13#10 +
|
|
'print(table.key)');
|
|
CheckEquals('value', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.TableLuaFunction;
|
|
var
|
|
input: ILuaTable;
|
|
returnValues: ILuaReadParameters;
|
|
|
|
begin
|
|
input := TLuaTable.Create;
|
|
input.SetValue('bob', 'release roderick!');
|
|
|
|
Lua.LoadFromString('function pilate(crowd)'#13#10 +
|
|
' local value, count = string.gsub(crowd.bob, "r", "w")'#13#10 +
|
|
' return value'#13#10 +
|
|
'end');
|
|
|
|
returnValues := Lua.Call('pilate', [input]);
|
|
CheckEquals(1, returnValues.Count, 'returnValues Count');
|
|
CheckEquals('welease wodewick!', returnValues[0].AsString, 'returnValue[0]');
|
|
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;
|
|
returnValues: ILuaReadParameters;
|
|
|
|
begin
|
|
Lua.LoadFromString('functions = {}'#13#10 +
|
|
'functions.callme = function(name)'#13#10 +
|
|
' return "Hello "..name'#13#10 +
|
|
'end'#13#10 +
|
|
'functions.callmetoo = function()'#13#10 +
|
|
' print("So long, and thanks for all the fish.")'#13#10 +
|
|
'end'#13#10);
|
|
|
|
functions := Lua.GetGlobalVariable('functions').AsTable;
|
|
returnValues := functions.GetValue('callme').AsFunction.Call(['Jack']);
|
|
|
|
CheckEquals('Hello Jack', returnValues.AsString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.ByteCode;
|
|
var
|
|
compileLua: TLua;
|
|
byteCode: TMemoryStream;
|
|
|
|
begin
|
|
byteCode := TMemoryStream.Create;
|
|
try
|
|
compileLua := TLua.Create;
|
|
try
|
|
compileLua.LoadFromString('print("Hello world!")', False);
|
|
compileLua.GetByteCode(byteCode, True);
|
|
finally
|
|
FreeAndNil(compileLua);
|
|
end;
|
|
|
|
byteCode.Position := 0;
|
|
Lua.LoadFromStream(byteCode);
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
finally
|
|
FreeAndNil(byteCode);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.Capture;
|
|
begin
|
|
// Capture is a convenience method which puts a script's variables and
|
|
// functions in a global table variable. Useful for example when
|
|
// implementing a sandboxed API.
|
|
Lua.LoadFromString('message = "Hello world!"'#13#10 +
|
|
'function outputMessage()'#13#10 +
|
|
' print(message)'#13#10 +
|
|
'end', False, 'Script1');
|
|
Lua.Capture('Captured');
|
|
|
|
Lua.LoadFromString('print(Captured.message)'#13#10 +
|
|
'Captured.message = "Goodbye world!"'#13#10 +
|
|
'Captured.outputMessage()', True, 'Script2');
|
|
|
|
CheckEquals('Hello world!Goodbye world!', Printed.ToString);
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.DenyRequire;
|
|
begin
|
|
try
|
|
// This should fail, since we're not loading the Package library which
|
|
// adds the require function that can be considered a security risk.
|
|
Lua.LoadFromString('require("Test")');
|
|
Fail('ELuaException expected');
|
|
except
|
|
on E:Exception do
|
|
begin
|
|
CheckIs(E, ELuaException);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.RegisterObject;
|
|
var
|
|
testObject: TTestObject;
|
|
|
|
begin
|
|
testObject := TTestObject.Create(FPrinted);
|
|
try
|
|
Lua.RegisterFunctions(testObject);
|
|
Lua.LoadFromString('Method1("Hello")'#13#10 +
|
|
'Method2("world!")');
|
|
|
|
CheckEquals('Method1:HelloMethod2:world!', Printed.ToString);
|
|
finally
|
|
FreeAndNil(testObject);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.RegisterObjectTable;
|
|
var
|
|
testObject: TTestObject;
|
|
|
|
begin
|
|
testObject := TTestObject.Create(FPrinted);
|
|
try
|
|
Lua.RegisterFunctions(testObject, 'Test');
|
|
Lua.LoadFromString('Test.Method1("Hello")'#13#10 +
|
|
'Test.Method2("world!")');
|
|
|
|
CheckEquals('Method1:HelloMethod2:world!', Printed.ToString);
|
|
finally
|
|
FreeAndNil(testObject);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTestWrapper.LoadFromFile;
|
|
var
|
|
fileName: string;
|
|
script: TStringList;
|
|
|
|
begin
|
|
fileName := TPath.GetTempFileName;
|
|
try
|
|
script := TStringList.Create;
|
|
try
|
|
script.Add('print("Hello world!")');
|
|
script.SaveToFile(fileName);
|
|
finally
|
|
FreeAndNil(script);
|
|
end;
|
|
|
|
Lua.LoadFromFile(fileName);
|
|
CheckEquals('Hello world!', Printed.ToString);
|
|
finally
|
|
TFile.Delete(fileName);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TTestObject }
|
|
constructor TTestObject.Create(AOutput: TStringBuilder);
|
|
begin
|
|
inherited Create;
|
|
|
|
FOutput := AOutput;
|
|
end;
|
|
|
|
|
|
procedure TTestObject.Method1(AContext: ILuaContext);
|
|
begin
|
|
FOutput.Append('Method1:' + AContext.Parameters[0].AsString);
|
|
end;
|
|
|
|
procedure TTestObject.Method2(AContext: ILuaContext);
|
|
begin
|
|
FOutput.Append('Method2:' + AContext.Parameters[0].AsString);
|
|
end;
|
|
|
|
initialization
|
|
RegisterTest(TTestWrapper.Suite);
|
|
|
|
end.
|