dist/Safe/t/safeuniversal.t

   1 #!perl
   2
   3 BEGIN {
   4     require Config;
   5     import Config;
   6     if ($Config{'extensions'} !~ /\bOpcode\b/) {
   7         print "1..0\n";
   8         exit 0;
   9     }
  10 }
  11
  12 use strict;
  13 use warnings;
  14 use Test::More;
  15 use Safe;
  16 plan(tests => 6);
  17
  18 my $c = new Safe;
  19 $c->permit(qw(require caller));
  20
  21 my $no_warn_redef = ($] != 5.008009)
  22     ? q(no warnings 'redefine';)
  23     : q($SIG{__WARN__}=sub{};);
  24 my $r = $c->reval($no_warn_redef . q!
  25     sub UNIVERSAL::isa { "pwned" }
  26     (bless[],"Foo")->isa("Foo");
  27 !);
  28
  29 is( $r, "pwned", "isa overridden in compartment" );
  30 is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" );
  31
  32 sub Foo::foo {}
  33
  34 $r = $c->reval($no_warn_redef . q!
  35     sub UNIVERSAL::can { "pwned" }
  36     (bless[],"Foo")->can("foo");
  37 !);
  38
  39 is( $r, "pwned", "can overridden in compartment" );
  40 is( (bless[],"Foo")->can("foo"), \&Foo::foo, "... but not outside" );
  41
  42 $r = $c->reval(q!
  43     utf8::is_utf8("\x{100}");
  44 !);
  45 is( $@, '', 'can call utf8::is_valid' );
  46 is( $r, 1, '... returns 1' );