1#!./perl -w 2$|=1; 3BEGIN { 4 require Config; import Config; 5 if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { 6 print "1..0\n"; 7 exit 0; 8 } 9 10} 11 12# Tests Todo: 13# 'main' as root 14 15package test; # test from somewhere other than main 16 17our $bar; 18 19use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex 20 opmask_add full_opset empty_opset opcodes opmask define_optag); 21 22use Safe 1.00; 23use Test::More; 24 25my $cpt; 26# create and destroy some automatic Safe compartments first 27$cpt = new Safe or die; 28$cpt = new Safe or die; 29$cpt = new Safe or die; 30 31$cpt = new Safe "Root" or die; 32 33foreach(1..3) { 34 $foo = 42; 35 36 $cpt->share(qw($foo)); 37 38 is(${$cpt->varglob('foo')}, 42); 39 40 ${$cpt->varglob('foo')} = 9; 41 42 is($foo, 9); 43 44 is($cpt->reval('$foo'), 9); 45 is($cpt->reval('$::foo'), 9, "check 'main' has been changed"); 46 is($cpt->reval('$main::foo'), 9, "check 'main' has been changed"); 47 is($cpt->reval('$test::foo'), undef, 48 "check we can't see our test package"); 49 is($cpt->reval('${"test::foo"}'), undef, 50 "check we can't see our test package"); 51 52 $cpt->erase; 53 is($cpt->reval('$foo'), undef, 54 'erasing the compartment deleted all variables'); 55 56 # Note that we *must* use $cpt->varglob here because if we used 57 # $Root::foo etc we would still see the original values! 58 # This seems to be because the compiler has created an extra ref. 59 60 is(${$cpt->varglob('foo')}, undef); 61} 62 63done_testing(); 64