This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
5ef384262dcf25cf1b3a6814d568d0dfda20cf7e
[perl5.git] / ext / Safe / t / safeuniversal.t
1 #!perl
2
3 BEGIN {
4     if ($ENV{PERL_CORE}) {
5         chdir 't' if -d 't';
6         @INC = '../lib';
7     }
8     require Config;
9     import Config;
10     if ($Config{'extensions'} !~ /\bOpcode\b/) {
11         print "1..0\n";
12         exit 0;
13     }
14 }
15
16 use strict;
17 use warnings;
18 use Test::More;
19 use Safe;
20 plan(tests => 6);
21
22 my $c = new Safe;
23 $c->permit(qw(require caller));
24
25 my $r = $c->reval(q!
26     no warnings 'redefine';
27     sub UNIVERSAL::isa { "pwned" }
28     (bless[],"Foo")->isa("Foo");
29 !);
30
31 is( $r, "pwned", "isa overriden in compartment" );
32 is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" );
33
34 sub Foo::foo {}
35
36 $r = $c->reval(q!
37     no warnings 'redefine';
38     sub UNIVERSAL::can { "pwned" }
39     (bless[],"Foo")->can("foo");
40 !);
41
42 is( $r, "pwned", "can overriden in compartment" );
43 is( (bless[],"Foo")->can("foo"), \&Foo::foo, "... but not outside" );
44
45 $r = $c->reval(q!
46     utf8::is_utf8("\x{100}");
47 !);
48 is( $@, '', 'can call utf8::is_valid' );
49 is( $r, 1, '... returns 1' );