| 1 | #!perl |
|---|
| 2 | |
|---|
| 3 | # Copyright (C) 2006-2008, The Perl Foundation. |
|---|
| 4 | # $Id: $ |
|---|
| 5 | |
|---|
| 6 | use strict; |
|---|
| 7 | use warnings; |
|---|
| 8 | |
|---|
| 9 | use Test::More; |
|---|
| 10 | use File::Spec; |
|---|
| 11 | |
|---|
| 12 | my $pipp_pbc = File::Spec->catfile( '..', '..', 'languages', 'pipp', 'pipp.pbc' ); |
|---|
| 13 | plan skip_all => "Need to first run make in languages/pipp" if not -e $pipp_pbc; |
|---|
| 14 | |
|---|
| 15 | plan tests => 14; |
|---|
| 16 | |
|---|
| 17 | use_ok('Parrot::Embed') or exit; |
|---|
| 18 | |
|---|
| 19 | my $module = 'Parrot::Interpreter'; |
|---|
| 20 | my $interp = $module->new(); |
|---|
| 21 | ok( $interp, 'new() should return a valid interpreter' ); |
|---|
| 22 | isa_ok( $interp, $module ); |
|---|
| 23 | |
|---|
| 24 | my $result = eval { $interp->load_file($pipp_pbc) }; |
|---|
| 25 | my $except = $@; |
|---|
| 26 | ok( $result, '... returning true if it could load the file' ); |
|---|
| 27 | is( $except, '', '... throwing no exeption if so' ); |
|---|
| 28 | |
|---|
| 29 | my $pipp_x = $interp->find_global( 'Pipp' ); |
|---|
| 30 | isa_ok( $pipp_x, 'Parrot::PMC' ); |
|---|
| 31 | #can_ok($pipp_x, 'invoke'); |
|---|
| 32 | #??? |
|---|
| 33 | |
|---|
| 34 | my $pipp = $interp->find_global( 'pipp', 'Pipp' ); |
|---|
| 35 | isa_ok( $pipp, 'Parrot::PMC' ); |
|---|
| 36 | can_ok($pipp, 'invoke'); |
|---|
| 37 | |
|---|
| 38 | |
|---|
| 39 | my $code = <<'END_CODE'; |
|---|
| 40 | <?php |
|---|
| 41 | function add($a, $b) { |
|---|
| 42 | return $a+$b; |
|---|
| 43 | } |
|---|
| 44 | ?> |
|---|
| 45 | END_CODE |
|---|
| 46 | |
|---|
| 47 | # compile some PHP code |
|---|
| 48 | { |
|---|
| 49 | my $pmc = $pipp->invoke( 'PS', $code ); |
|---|
| 50 | ok( $pmc, 'invoke() should return a PMC, given that signature' ); |
|---|
| 51 | is( $pmc->get_string(), 1, 'string returned in the PMC should be true?' ); |
|---|
| 52 | } |
|---|
| 53 | |
|---|
| 54 | |
|---|
| 55 | # invoke a built-in php function |
|---|
| 56 | { |
|---|
| 57 | my $pmc = $pipp->invoke( 'PS', 'strlen', 'some string' ); |
|---|
| 58 | ok( $pmc, 'invoke() should return a PMC, given that signature' ); |
|---|
| 59 | is( $pmc->get_string(), 11, 'value returned in the PMC' ); |
|---|
| 60 | } |
|---|
| 61 | |
|---|
| 62 | # invoke a php function |
|---|
| 63 | { |
|---|
| 64 | my $pmc = $pipp->invoke( 'PS', 'add', 23, 19 ); |
|---|
| 65 | ok( $pmc, 'invoke() should return a PMC, given that signature' ); |
|---|
| 66 | is( $pmc->get_string(), 42, 'value returned in the PMC' ); |
|---|
| 67 | } |
|---|