This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/safeuniversal.t failure under 5.8.9
[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 $no_warn_redef = ($] != 5.008009)
26     ? q(no warnings 'redefine';)
27     : q($SIG{__WARN__}=sub{};);
28 my $r = $c->reval($no_warn_redef . q!
29     sub UNIVERSAL::isa { "pwned" }
30     (bless[],"Foo")->isa("Foo");
31 !);
32
33 is( $r, "pwned", "isa overriden in compartment" );
34 is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" );
35
36 sub Foo::foo {}
37
38 $r = $c->reval($no_warn_redef . q!
39     sub UNIVERSAL::can { "pwned" }
40     (bless[],"Foo")->can("foo");
41 !);
42
43 is( $r, "pwned", "can overriden in compartment" );
44 is( (bless[],"Foo")->can("foo"), \&Foo::foo, "... but not outside" );
45
46 $r = $c->reval(q!
47     utf8::is_utf8("\x{100}");
48 !);
49 is( $@, '', 'can call utf8::is_valid' );
50 is( $r, 1, '... returns 1' );