Help language development. Donate to The Perl Foundation
#!/usr/bin/env perl6 use v6; use Inline::Perl5; say "1..12"; my $p5 = Inline::Perl5.new(); say $p5.run: q:to<PERL>; use 5.10.0; $| = 1; sub test { say "ok 1 - executing a parameterless function without return value"; return; } sub test_int_params { if ($_[0] == 2 and $_[1] == 1) { say "ok 2 - int params"; } else { say "not ok 2 - int params"; } return; } sub test_str_params { if (@_ == 2 and $_[0] eq "Hello" and $_[1] eq "Perl 5") { say "ok 3 - str params"; } else { say "not ok 3 - str params"; } return; } sub test_int_retval { return 1; } sub test_int_retvals { return 3, 1, 2; } sub test_str_retval { return "Hello Raku!"; } sub test_mixed_retvals { return ("Hello", "Perl", 6); } sub test_undef { my ($self, $undef) = @_; return (@_ == 2 and $self eq "main" and not defined $undef); } sub test_hash { my ($self, $h) = @_; return ( ref $h eq "HASH" and %$h == 2 and keys %$h == 2 and exists $h->{a} and exists $h->{b} and $h->{a} == 2 and ref $h->{b} and ref $h->{b} eq "HASH" and ref $h->{b}{c} and ref $h->{b}{c} eq "ARRAY" and @{ $h->{b}{c} } == 2 and $h->{b}{c}[0] == 4 and $h->{b}{c}[1] == 3 ); } sub test_foo { my ($self, $foo) = @_; return $foo->test; } package Foo; sub new { my ($class, $val) = @_; return bless \$val, $class; } sub test { my ($self) = @_; return $$self; } sub sum { my ($self, $a, $b) = @_; return $a + $b; } PERL $p5.call('test'); $p5.call('test_int_params', 2, 1); $p5.call('test_str_params', 'Hello', 'Perl 5'); if ($p5.call('test_int_retval') == 1) { say "ok 4 - return one int"; } else { say "not ok 4 - return one int"; } my @retvals = $p5.call('test_int_retvals'); if (@retvals == 3 and @retvals[0] == 3 and @retvals[1] == 1 and @retvals[2] == 2) { say "ok 5 - return multiple ints"; } else { say "not ok 5 - return multiple ints"; say " got: {@retvals} ({@retvals.elems} elems)"; say " expected: 3, 1, 2"; } if ($p5.call('test_str_retval') eq 'Hello Raku!') { say "ok 6 - return one string"; } else { say "not ok 6 - return one string"; } @retvals = $p5.call('test_mixed_retvals'); if (@retvals == 3 and @retvals[0] eq 'Hello' and @retvals[1] eq 'Perl' and @retvals[2] == 6) { say "ok 7 - return mixed values"; } else { say "not ok 7 - return mixed values"; say " got: {@retvals}"; say " expected: 'Hello', 'Perl', 6"; } if ($p5.call('Foo::new', 'Foo', 1).test() == 1) { say "ok 8 - Perl 5 method call"; } else { say "not ok 8 - Perl 5 method call"; } if ($p5.call('Foo::new', 'Foo', 1).sum(3, 1) == 4) { say "ok 9 - Perl 5 method call with parameters"; } else { say "not ok 9 - Perl 5 method call with parameters"; } if ($p5.call('test_undef', 'main', Any) == 1) { say "ok 10 - Any converted to undef"; } else { say "not ok 10 - Any converted to undef"; } if ($p5.call('test_hash', 'main', {a => 2, b => {c => [4, 3]}}) == 1) { say "ok 11 - Passing hashes to Perl 5"; } else { say "not ok 11 - Passing hashes to Perl 5"; } if ($p5.call('test_foo', 'main', $p5.call('Foo::new', 'Foo', 6)) == 6) { say "ok 12 - Passing Perl 5 objects back from Raku"; } else { say "not ok 12 - Passing Perl 5 objects back from Raku"; } $p5.DESTROY; # vim: ft=raku