ext/Parrot-Embed/t/interp.t

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