diff options
Diffstat (limited to 'tests/TestLua.pm')
-rw-r--r-- | tests/TestLua.pm | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/tests/TestLua.pm b/tests/TestLua.pm new file mode 100644 index 0000000..cd22d83 --- /dev/null +++ b/tests/TestLua.pm | |||
@@ -0,0 +1,70 @@ | |||
1 | package TestLua; | ||
2 | |||
3 | use Test::Base -Base; | ||
4 | use IPC::Run3; | ||
5 | use Cwd; | ||
6 | |||
7 | use Test::LongString; | ||
8 | |||
9 | our @EXPORT = qw( run_tests ); | ||
10 | |||
11 | $ENV{LUA_CPATH} = "../?.so;;"; | ||
12 | $ENV{LUA_PATH} = "../lua/?.lua;;"; | ||
13 | #$ENV{LUA_PATH} = ($ENV{LUA_PATH} || "" ) . ';' . getcwd . "/runtime/?.lua" . ';;'; | ||
14 | |||
15 | sub run_test ($) { | ||
16 | my $block = shift; | ||
17 | #print $json_xs->pretty->encode(\@new_rows); | ||
18 | #my $res = #print $json_xs->pretty->encode($res); | ||
19 | my $name = $block->name; | ||
20 | |||
21 | my $lua = $block->lua or | ||
22 | die "No --- lua specified for test $name\n"; | ||
23 | |||
24 | my $luafile = "test_case.lua"; | ||
25 | |||
26 | open my $fh, ">$luafile" or | ||
27 | die "Cannot open $luafile for writing: $!\n"; | ||
28 | |||
29 | print $fh $lua; | ||
30 | close $fh; | ||
31 | |||
32 | my ($res, $err); | ||
33 | |||
34 | my @cmd; | ||
35 | |||
36 | if ($ENV{TEST_LUA_USE_VALGRIND}) { | ||
37 | @cmd = ('valgrind', '-q', '--leak-check=full', 'lua', 'test_case.lua'); | ||
38 | } else { | ||
39 | @cmd = ('lua', 'test_case.lua'); | ||
40 | } | ||
41 | |||
42 | run3 \@cmd, undef, \$res, \$err; | ||
43 | my $rc = $?; | ||
44 | |||
45 | #warn "res:$res\nerr:$err\n"; | ||
46 | |||
47 | if (defined $block->err) { | ||
48 | $err =~ /.*:.*:.*: (.*\s)?/; | ||
49 | $err = $1; | ||
50 | is $err, $block->err, "$name - err expected"; | ||
51 | |||
52 | } elsif ($rc) { | ||
53 | die "Failed to execute --- lua for test $name: $err\n"; | ||
54 | |||
55 | } else { | ||
56 | #is $res, $block->out, "$name - output ok"; | ||
57 | is $res, $block->out, "$name - output ok"; | ||
58 | } | ||
59 | |||
60 | is $rc, ($block->exit || 0), "$name - exit code ok"; | ||
61 | #unlink 'test_case.lua' or warn "could not delete \'test_case.lua\':$!"; | ||
62 | } | ||
63 | |||
64 | sub run_tests () { | ||
65 | for my $block (blocks()) { | ||
66 | run_test($block); | ||
67 | } | ||
68 | } | ||
69 | |||
70 | 1; | ||