-
Notifications
You must be signed in to change notification settings - Fork 138
/
interp.t
108 lines (81 loc) · 2.94 KB
/
interp.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#!perl
# Copyright (C) 2006-2010, Parrot Foundation.
use strict;
use warnings;
use Test::More tests => 23;
use File::Spec;
my $hello_pbc = File::Spec->catfile( 't', 'greet.pbc' );
my $module = 'Parrot::Interpreter';
use_ok('Parrot::Embed') or exit;
can_ok( $module, 'new' );
my $interp = $module->new();
ok( $interp, 'new() should return a valid interpreter' );
isa_ok( $interp, $module );
can_ok( $module, 'load_file' );
my $result = eval { $interp->load_file('no file here') };
my $except = $@;
ok( !$result, 'load_file() should return false unless it can load a file' );
like( $except, qr/File 'no file here' not found/, '... throwing exception' );
$result = eval { $interp->load_file($hello_pbc) };
$except = $@;
ok( $result, '... returning true if it could load the file' );
is( $except, '', '... throwing no exception if so' );
can_ok( $module, 'find_global' );
my $global_greet = $interp->find_global('greet');
ok( $global_greet, 'find_global() should return non-namespaced global, if found' );
isa_ok( $global_greet, 'Parrot::PMC' );
ok( !$interp->find_global('goat'),
'... or nothing, if there is no non-namespaced global of that name' );
my $else_greet = $interp->find_global( 'greet', 'Elsewhere' );
ok( $else_greet, '... or a namespaced global, if it exists in the namespace' );
isnt( $$global_greet, $$else_greet, '... and definitely the namespaced version' );
ok( !$interp->find_global( 'goat', 'Elsewhere' ),
'... but again, not if there is no global of that name there' );
can_ok( $global_greet, 'invoke' );
my $pmc = $global_greet->invoke( 'S->P', 'Bob' );
ok( $pmc, 'invoke() should return a PMC, given that signature' );
is( $pmc->get_string(), 'Hello, Bob!', '... containing a string returned in the PMC' );
can_ok( $module, 'compile' );
my $eval = $interp->compile( <<END_PIR );
.sub foo
.param pmc in_string
.local string string_s
string_s = in_string
string_s .= ' FOO '
.return( string_s )
.end
END_PIR
ok( $eval, 'compile() should compile PIR code and return a PMC' );
isa_ok( $eval, 'Parrot::PMC' );
=for comment
TODO:
{
local $TODO = 'compile_string() returns wrong results';
# ok( !$interp->compile('blah'), '... but only for valid PIR' );
}
$pmc = $else_greet->invoke( 'S->P', '' );
is( $pmc->get_string(), 'Hiya!', '... calling the passed-in subroutine' );
my $foo = $interp->find_global('foo');
$pmc = $foo->invoke( 'S->P', 'BAR' );
is( $pmc->get_string(), 'BAR FOO ',
'... and compiled sub should work just like any other Sub pmc' );
my $foo;
=cut
my $foo;
{
my $die_interp = $module->new($interp);
eval { $die_interp->load_file($hello_pbc) };
$foo = $die_interp->find_global('greet');
}
$pmc = $foo->invoke( 'S->P', 'out of scope' );
is(
$pmc->get_string(),
'Hello, out of scope!',
'... even if interpreter object has gone out of scope'
);
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: