summaryrefslogtreecommitdiff
path: root/dist/Safe/t
diff options
context:
space:
mode:
Diffstat (limited to 'dist/Safe/t')
-rw-r--r--dist/Safe/t/safe1.t67
-rw-r--r--dist/Safe/t/safe2.t153
-rw-r--r--dist/Safe/t/safe3.t46
-rw-r--r--dist/Safe/t/safeload.t26
-rw-r--r--dist/Safe/t/safeops.t428
-rw-r--r--dist/Safe/t/safeuniversal.t46
6 files changed, 766 insertions, 0 deletions
diff --git a/dist/Safe/t/safe1.t b/dist/Safe/t/safe1.t
new file mode 100644
index 0000000000..385d6610c5
--- /dev/null
+++ b/dist/Safe/t/safe1.t
@@ -0,0 +1,67 @@
+#!./perl -w
+$|=1;
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n";
+ exit 0;
+ }
+
+}
+
+# Tests Todo:
+# 'main' as root
+
+package test; # test from somewhere other than main
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+ opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my $t = 1;
+my $cpt;
+# create and destroy some automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root" or die;
+
+foreach(1..3) {
+ $foo = 42;
+
+ $cpt->share(qw($foo));
+
+ print ${$cpt->varglob('foo')} == 42 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+ ${$cpt->varglob('foo')} = 9;
+
+ print $foo == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+ print $cpt->reval('$foo') == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
+ # check 'main' has been changed:
+ print $cpt->reval('$::foo') == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
+ print $cpt->reval('$main::foo') == 9 ? "ok $t\n" : "not ok $t\n"; $t++;
+ # check we can't see our test package:
+ print $cpt->reval('$test::foo') ? "not ok $t\n" : "ok $t\n"; $t++;
+ print $cpt->reval('${"test::foo"}') ? "not ok $t\n" : "ok $t\n"; $t++;
+
+ $cpt->erase; # erase the compartment, e.g., delete all variables
+
+ print $cpt->reval('$foo') ? "not ok $t\n" : "ok $t\n"; $t++;
+
+ # Note that we *must* use $cpt->varglob here because if we used
+ # $Root::foo etc we would still see the original values!
+ # This seems to be because the compiler has created an extra ref.
+
+ print ${$cpt->varglob('foo')} ? "not ok $t\n" : "ok $t\n"; $t++;
+}
+
+print "ok $last_test\n";
+BEGIN { $last_test = 28 }
diff --git a/dist/Safe/t/safe2.t b/dist/Safe/t/safe2.t
new file mode 100644
index 0000000000..2548dcc6e8
--- /dev/null
+++ b/dist/Safe/t/safe2.t
@@ -0,0 +1,153 @@
+#!./perl -w
+$|=1;
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+# Tests Todo:
+# 'main' as root
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+ opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+$bar = "invisible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+
+my $cpt;
+# create and destroy a couple of automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root";
+
+$cpt->permit(qw(:base_io));
+
+$cpt->reval(q{ system("echo not ok 1"); });
+if ($@ =~ /^'?system'? trapped by operation mask/) {
+ print "ok 1\n";
+} else {
+ print "#$@" if $@;
+ print "not ok 1\n";
+}
+
+$cpt->reval(q{
+ print $foo eq 'visible' ? "ok 2\n" : "not ok 2\n";
+ print $main::foo eq 'visible' ? "ok 3\n" : "not ok 3\n";
+ print defined($bar) ? "not ok 4\n" : "ok 4\n";
+ print defined($::bar) ? "not ok 5\n" : "ok 5\n";
+ print defined($main::bar) ? "not ok 6\n" : "ok 6\n";
+});
+print $@ ? "not ok 7\n#$@" : "ok 7\n";
+
+$foo = "ok 8\n";
+%bar = (key => "ok 9\n");
+@baz = (); push(@baz, "o", "10"); $" = 'k ';
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+sub sayok { print "ok @_\n" }
+
+$cpt->share(qw($foo %bar @baz *glob sayok));
+$cpt->share('$"') unless $Config{use5005threads};
+
+$cpt->reval(q{
+ package other;
+ sub other_sayok { print "ok @_\n" }
+ package main;
+ print $foo ? $foo : "not ok 8\n";
+ print $bar{key} ? $bar{key} : "not ok 9\n";
+ (@baz) ? print "@baz\n" : print "not ok 10\n";
+ print $glob;
+ other::other_sayok(12);
+ $foo =~ s/8/14/;
+ $bar{new} = "ok 15\n";
+ @glob = qw(ok 16);
+});
+print $@ ? "not ok 13\n#$@" : "ok 13\n";
+$" = ' ';
+print $foo, $bar{new}, "@glob\n";
+
+$Root::foo = "not ok 17";
+@{$cpt->varglob('bar')} = qw(not ok 18);
+${$cpt->varglob('foo')} = "ok 17";
+@Root::bar = "ok";
+push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+print "$Root::foo\n";
+print "@{$cpt->varglob('bar')}\n";
+
+use strict;
+
+print 1 ? "ok 19\n" : "not ok 19\n";
+print 1 ? "ok 20\n" : "not ok 20\n";
+
+my $m1 = $cpt->mask;
+$cpt->trap("negate");
+my $m2 = $cpt->mask;
+my @masked = opset_to_ops($m1);
+print $m2 eq opset("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+
+print eval { $cpt->mask("a bad mask") } ? "not ok 22\n" : "ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
+
+$cpt->mask(empty_opset);
+my $t_scalar = $cpt->reval('print wantarray ? "not ok 24\n" : "ok 24\n"');
+print $cpt->reval('@ary=(6,7,8);@ary') == 3 ? "ok 25\n" : "not ok 25\n";
+my @t_array = $cpt->reval('print wantarray ? "ok 26\n" : "not ok 26\n"; (2,3,4)');
+print $t_array[2] == 4 ? "ok 27\n" : "not ok 27\n";
+
+my $t_scalar2 = $cpt->reval('die "foo bar"; 1');
+print defined $t_scalar2 ? "not ok 28\n" : "ok 28\n";
+print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
+
+# --- rdo
+
+my $t = 30;
+$! = 0;
+my $nosuch = '/non/existant/file.name';
+open(NOSUCH, $nosuch);
+if ($@) {
+ my $errno = $!;
+ die "Eek! Attempting to open $nosuch failed, but \$! is still 0" unless $!;
+ $! = 0;
+ $cpt->rdo($nosuch);
+ print $! == $errno ? "ok $t\n" : sprintf "not ok $t # \"$!\" is %d (expected %d)\n", $!, $errno; $t++;
+} else {
+ die "Eek! Didn't expect $nosuch to be there.";
+}
+close(NOSUCH);
+
+# test #31 is gone.
+print "ok $t\n"; $t++;
+
+#my $rdo_file = "tmp_rdo.tpl";
+#if (open X,">$rdo_file") {
+# print X "999\n";
+# close X;
+# $cpt->permit_only('const', 'leaveeval');
+# print $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++;
+# unlink $rdo_file;
+#}
+#else {
+# print "# test $t skipped, can't open file: $!\nok $t\n"; $t++;
+#}
+
+
+print "ok $last_test\n";
+BEGIN { $last_test = 32 }
diff --git a/dist/Safe/t/safe3.t b/dist/Safe/t/safe3.t
new file mode 100644
index 0000000000..1f99f49ed9
--- /dev/null
+++ b/dist/Safe/t/safe3.t
@@ -0,0 +1,46 @@
+#!perl -w
+
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/
+ && $Config{'extensions'} !~ /\bPOSIX\b/
+ && $Config{'osname'} ne 'VMS')
+ {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings;
+use POSIX qw(ceil);
+use Test::More tests => 2;
+use Safe;
+
+my $safe = new Safe;
+$safe->deny('add');
+
+my $masksize = ceil( Opcode::opcodes / 8 );
+# Attempt to change the opmask from within the safe compartment
+$safe->reval( qq{\$_[1] = qq/\0/ x } . $masksize );
+
+# Check that it didn't work
+$safe->reval( q{$x + $y} );
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
+ 'opmask still in place with reval' );
+
+my $safe2 = new Safe;
+$safe2->deny('add');
+
+open my $fh, '>nasty.pl' or die "Can't write nasty.pl: $!\n";
+print $fh <<EOF;
+\$_[1] = "\0" x $masksize;
+EOF
+close $fh;
+$safe2->rdo('nasty.pl');
+$safe2->reval( q{$x + $y} );
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
+ 'opmask still in place with rdo' );
+END { unlink 'nasty.pl' }
diff --git a/dist/Safe/t/safeload.t b/dist/Safe/t/safeload.t
new file mode 100644
index 0000000000..2d2c3ccb4a
--- /dev/null
+++ b/dist/Safe/t/safeload.t
@@ -0,0 +1,26 @@
+#!perl
+
+BEGIN {
+ require Config;
+ import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/) {
+ print "1..0\n";
+ exit 0;
+ }
+ # Can we load the version module ?
+ eval { require version; 1 } or do {
+ print "1..0 # no version.pm\n";
+ exit 0;
+ };
+ delete $INC{"version.pm"};
+}
+
+use strict;
+use Test::More;
+use Safe;
+plan(tests => 1);
+
+my $c = new Safe;
+$c->permit(qw(require caller entereval unpack));
+my $r = $c->reval(q{ use version; 1 });
+ok( defined $r, "Can load version.pm in a Safe compartment" ) or diag $@;
diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t
new file mode 100644
index 0000000000..bd8217d8dc
--- /dev/null
+++ b/dist/Safe/t/safeops.t
@@ -0,0 +1,428 @@
+#!perl
+# Tests that all ops can be trapped by a Safe compartment
+
+BEGIN {
+ unless ($ENV{PERL_CORE}) {
+ # this won't work outside of the core, so exit
+ print "1..0 # skipped: PERL_CORE unset\n"; exit 0;
+ }
+}
+use Config;
+BEGIN {
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n"; exit 0;
+ }
+}
+
+use strict;
+use Test::More;
+use Safe;
+
+# Read the op names and descriptions directly from opcode.pl
+my @op;
+my %code;
+
+while (<DATA>) {
+ chomp;
+ die "Can't match $_" unless /^([a-z_0-9]+)\t+(.*)/;
+ $code{$1} = $2;
+}
+
+open my $fh, '<', '../../opcode.pl' or die "Can't open opcode.pl: $!";
+while (<$fh>) {
+ last if /^__END__/;
+}
+while (<$fh>) {
+ chomp;
+ next if !$_ or /^#/;
+ my ($op, $opname) = split /\t+/;
+ push @op, [$op, $opname, $code{$op}];
+}
+close $fh;
+
+plan(tests => scalar @op);
+
+sub testop {
+ my ($op, $opname, $code) = @_;
+ pass("$op : skipped") and return if $code =~ /^SKIP/;
+ pass("$op : skipped") and return if $code =~ m://|~~: && $] < 5.010;
+ my $c = new Safe;
+ $c->deny_only($op);
+ $c->reval($code);
+ like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
+}
+
+foreach (@op) {
+ if ($_->[2]) {
+ testop @$_;
+ } else {
+ local $TODO = "No test yet for $_->[1]";
+ fail();
+ }
+}
+
+# things that begin with SKIP are skipped, for various reasons (notably
+# optree modified by the optimizer -- Safe checks are done before the
+# optimizer modifies the optree)
+
+__DATA__
+null SKIP
+stub SKIP
+scalar scalar $x
+pushmark print @x
+wantarray wantarray
+const 42
+gvsv SKIP (set by optimizer) $x
+gv SKIP *x
+gelem *x{SCALAR}
+padsv SKIP my $x
+padav SKIP my @x
+padhv SKIP my %x
+padany SKIP (not implemented)
+pushre SKIP split /foo/
+rv2gv *x
+rv2sv $x
+av2arylen $#x
+rv2cv f()
+anoncode sub { }
+prototype prototype 'foo'
+refgen \($x,$y)
+srefgen SKIP \$x
+ref ref
+bless bless
+backtick qx/ls/
+glob <*.c>
+readline <FH>
+rcatline SKIP (set by optimizer) $x .= <F>
+regcmaybe SKIP (internal)
+regcreset SKIP (internal)
+regcomp SKIP (internal)
+match /foo/
+qr qr/foo/
+subst s/foo/bar/
+substcont SKIP (set by optimizer)
+trans y:z:t:
+sassign $x = $y
+aassign @x = @y
+chop chop @foo
+schop chop
+chomp chomp @foo
+schomp chomp
+defined defined
+undef undef
+study study
+pos pos
+preinc ++$i
+i_preinc SKIP (set by optimizer)
+predec --$i
+i_predec SKIP (set by optimizer)
+postinc $i++
+i_postinc SKIP (set by optimizer)
+postdec $i--
+i_postdec SKIP (set by optimizer)
+pow $x ** $y
+multiply $x * $y
+i_multiply SKIP (set by optimizer)
+divide $x / $y
+i_divide SKIP (set by optimizer)
+modulo $x % $y
+i_modulo SKIP (set by optimizer)
+repeat $x x $y
+add $x + $y
+i_add SKIP (set by optimizer)
+subtract $x - $y
+i_subtract SKIP (set by optimizer)
+concat $x . $y
+stringify "$x"
+left_shift $x << 1
+right_shift $x >> 1
+lt $x < $y
+i_lt SKIP (set by optimizer)
+gt $x > $y
+i_gt SKIP (set by optimizer)
+le $i <= $y
+i_le SKIP (set by optimizer)
+ge $i >= $y
+i_ge SKIP (set by optimizer)
+eq $x == $y
+i_eq SKIP (set by optimizer)
+ne $x != $y
+i_ne SKIP (set by optimizer)
+ncmp $i <=> $y
+i_ncmp SKIP (set by optimizer)
+slt $x lt $y
+sgt $x gt $y
+sle $x le $y
+sge $x ge $y
+seq $x eq $y
+sne $x ne $y
+scmp $x cmp $y
+bit_and $x & $y
+bit_xor $x ^ $y
+bit_or $x | $y
+negate -$x
+i_negate SKIP (set by optimizer)
+not !$x
+complement ~$x
+atan2 atan2 1
+sin sin 1
+cos cos 1
+rand rand
+srand srand
+exp exp 1
+log log 1
+sqrt sqrt 1
+int int
+hex hex
+oct oct
+abs abs
+length length
+substr substr $x, 1
+vec vec
+index index
+rindex rindex
+sprintf sprintf '%s', 'foo'
+formline formline
+ord ord
+chr chr
+crypt crypt 'foo','bar'
+ucfirst ucfirst
+lcfirst lcfirst
+uc uc
+lc lc
+quotemeta quotemeta
+rv2av @a
+aelemfast SKIP (set by optimizer)
+aelem $a[1]
+aslice @a[1,2]
+each each %h
+values values %h
+keys keys %h
+delete delete $h{Key}
+exists exists $h{Key}
+rv2hv %h
+helem $h{kEy}
+hslice @h{kEy}
+unpack unpack
+pack pack
+split split /foo/
+join join $a, @b
+list @x = (1,2)
+lslice SKIP @x[1,2]
+anonlist [1,2]
+anonhash { a => 1 }
+splice splice @x, 1, 2, 3
+push push @x, $x
+pop pop @x
+shift shift @x
+unshift unshift @x
+sort sort @x
+reverse reverse @x
+grepstart grep { $_ eq 'foo' } @x
+grepwhile SKIP grep { $_ eq 'foo' } @x
+mapstart map $_ + 1, @foo
+mapwhile SKIP (set by optimizer)
+range SKIP
+flip 1..2
+flop 1..2
+and $x && $y
+or $x || $y
+xor $x xor $y
+cond_expr $x ? 1 : 0
+andassign $x &&= $y
+orassign $x ||= $y
+method Foo->$x()
+entersub f()
+leavesub sub f{} f()
+leavesublv sub f:lvalue{return $x} f()
+caller caller
+warn warn
+die die
+reset reset
+lineseq SKIP
+nextstate SKIP
+dbstate SKIP (needs debugger)
+unstack while(0){}
+enter SKIP
+leave SKIP
+scope SKIP
+enteriter SKIP
+iter SKIP
+enterloop SKIP
+leaveloop SKIP
+return return
+last last
+next next
+redo redo THIS
+dump dump
+goto goto THERE
+exit exit 0
+open open FOO
+close close FOO
+pipe_op pipe FOO,BAR
+fileno fileno FOO
+umask umask 0755, 'foo'
+binmode binmode FOO
+tie tie
+untie untie
+tied tied
+dbmopen dbmopen
+dbmclose dbmclose
+sselect SKIP (set by optimizer)
+select select FOO
+getc getc FOO
+read read FOO
+enterwrite write
+leavewrite SKIP
+prtf printf
+print print
+sysopen sysopen
+sysseek sysseek
+sysread sysread
+syswrite syswrite
+send send
+recv recv
+eof eof FOO
+tell tell
+seek seek FH, $pos, $whence
+truncate truncate FOO, 42
+fcntl fcntl
+ioctl ioctl
+flock flock FOO, 1
+socket socket
+sockpair socketpair
+bind bind
+connect connect
+listen listen
+accept accept
+shutdown shutdown
+gsockopt getsockopt
+ssockopt setsockopt
+getsockname getsockname
+getpeername getpeername
+lstat lstat FOO
+stat stat FOO
+ftrread -R
+ftrwrite -W
+ftrexec -X
+fteread -r
+ftewrite -w
+fteexec -x
+ftis -e
+fteowned SKIP -O
+ftrowned SKIP -o
+ftzero -z
+ftsize -s
+ftmtime -M
+ftatime -A
+ftctime -C
+ftsock -S
+ftchr -c
+ftblk -b
+ftfile -f
+ftdir -d
+ftpipe -p
+ftlink -l
+ftsuid -u
+ftsgid -g
+ftsvtx -k
+fttty -t
+fttext -T
+ftbinary -B
+chdir chdir '/'
+chown chown
+chroot chroot
+unlink unlink 'foo'
+chmod chmod 511, 'foo'
+utime utime
+rename rename 'foo', 'bar'
+link link 'foo', 'bar'
+symlink symlink 'foo', 'bar'
+readlink readlink 'foo'
+mkdir mkdir 'foo'
+rmdir rmdir 'foo'
+open_dir opendir DIR
+readdir readdir DIR
+telldir telldir DIR
+seekdir seekdir DIR, $pos
+rewinddir rewinddir DIR
+closedir closedir DIR
+fork fork
+wait wait
+waitpid waitpid
+system system
+exec exec
+kill kill
+getppid getppid
+getpgrp getpgrp
+setpgrp setpgrp
+getpriority getpriority
+setpriority setpriority
+time time
+tms times
+localtime localtime
+gmtime gmtime
+alarm alarm
+sleep sleep 1
+shmget shmget
+shmctl shmctl
+shmread shmread
+shmwrite shmwrite
+msgget msgget
+msgctl msgctl
+msgsnd msgsnd
+msgrcv msgrcv
+semget semget
+semctl semctl
+semop semop
+require use strict
+dofile do 'file'
+entereval eval "1+1"
+leaveeval eval "1+1"
+entertry SKIP eval { 1+1 }
+leavetry SKIP eval { 1+1 }
+ghbyname gethostbyname 'foo'
+ghbyaddr gethostbyaddr 'foo'
+ghostent gethostent
+gnbyname getnetbyname 'foo'
+gnbyaddr getnetbyaddr 'foo'
+gnetent getnetent
+gpbyname getprotobyname 'foo'
+gpbynumber getprotobynumber 42
+gprotoent getprotoent
+gsbyname getservbyname 'name', 'proto'
+gsbyport getservbyport 'a', 'b'
+gservent getservent
+shostent sethostent
+snetent setnetent
+sprotoent setprotoent
+sservent setservent
+ehostent endhostent
+enetent endnetent
+eprotoent endprotoent
+eservent endservent
+gpwnam getpwnam
+gpwuid getpwuid
+gpwent getpwent
+spwent setpwent
+epwent endpwent
+ggrnam getgrnam
+ggrgid getgrgid
+ggrent getgrent
+sgrent setgrent
+egrent endgrent
+getlogin getlogin
+syscall syscall
+lock SKIP
+threadsv SKIP
+setstate SKIP
+method_named $x->y()
+dor $x // $y
+dorassign $x //= $y
+once SKIP {use feature 'state'; state $foo = 42;}
+say SKIP {use feature 'say'; say "foo";}
+smartmatch $x ~~ $y
+aeach SKIP each @t
+akeys SKIP keys @t
+avalues SKIP values @t
+custom SKIP (no way)
diff --git a/dist/Safe/t/safeuniversal.t b/dist/Safe/t/safeuniversal.t
new file mode 100644
index 0000000000..95867c5a1f
--- /dev/null
+++ b/dist/Safe/t/safeuniversal.t
@@ -0,0 +1,46 @@
+#!perl
+
+BEGIN {
+ require Config;
+ import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/) {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings;
+use Test::More;
+use Safe;
+plan(tests => 6);
+
+my $c = new Safe;
+$c->permit(qw(require caller));
+
+my $no_warn_redef = ($] != 5.008009)
+ ? q(no warnings 'redefine';)
+ : q($SIG{__WARN__}=sub{};);
+my $r = $c->reval($no_warn_redef . q!
+ sub UNIVERSAL::isa { "pwned" }
+ (bless[],"Foo")->isa("Foo");
+!);
+
+is( $r, "pwned", "isa overriden in compartment" );
+is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" );
+
+sub Foo::foo {}
+
+$r = $c->reval($no_warn_redef . q!
+ sub UNIVERSAL::can { "pwned" }
+ (bless[],"Foo")->can("foo");
+!);
+
+is( $r, "pwned", "can overriden in compartment" );
+is( (bless[],"Foo")->can("foo"), \&Foo::foo, "... but not outside" );
+
+$r = $c->reval(q!
+ utf8::is_utf8("\x{100}");
+!);
+is( $@, '', 'can call utf8::is_valid' );
+is( $r, 1, '... returns 1' );
View Lorry Controller Status