Gecko [ www.blackthorn-inc.com ]

Linux cpanel2.daytoncreative.net 2.6.32-754.29.2.el6.x86_64 #1 SMP Tue May 12 17:39:04 UTC 2020 x86_64
Apache/2.4.43 (cPanel) OpenSSL/1.1.1g mod_bwlimited/1.4
Server IP : 70.62.220.67 & Your IP : 216.73.216.193
Domains : Cant Read [ /etc/named.conf ]
User : michaelgreg

Name	Size	Permission	Date
safe1.t	1.41 KB	-r--r--r--	2014-12-27 11:48
safe2.t	3.48 KB	-r--r--r--	2014-12-27 11:49
safe3.t	1.13 KB	-r--r--r--	2014-12-27 11:48
safeload.t	954 B	-r--r--r--	2014-12-27 11:48
safenamedcap.t	331 B	-r--r--r--	2014-12-27 11:48
safeops.t	8.61 KB	-r--r--r--	2014-12-27 11:49
saferegexp.t	620 B	-r--r--r--	2014-12-27 11:48
safesort.t	1.52 KB	-r--r--r--	2014-12-27 11:48
safeuniversal.t	959 B	-r--r--r--	2014-12-27 11:48
safeutf8.t	1.31 KB	-r--r--r--	2014-12-27 11:48
safewrap.t	1.16 KB	-r--r--r--	2014-12-27 11:48

Rename

#!perl -w
$|=1;
BEGIN {
    require Config; import Config;
    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
        print "1..0\n";
        exit 0;
    }
}

use Test::More tests => 7;

use Safe 1.00;
use Opcode qw(full_opset);

pass;

my $safe = Safe->new('PLPerl');
$safe->deny_only();

# Expression that triggers require utf8 and call to SWASHNEW.
# Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called"
# if SWASHNEW is not shared, else returns true if unicode logic is working.
my $trigger = q{ my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };

ok $safe->reval( $trigger ), 'trigger expression should return true';
is $@, '', 'trigger expression should not die';

# return a closure
my $sub = $safe->reval(q{sub { warn pack('U',0xC4) }});

# define code outside Safe that'll be triggered from inside
my @warns;
$SIG{__WARN__} = sub {
    my $msg = shift;
    # this regex requires a different SWASH digit data for \d)
    # than the one used above and by the trigger code in Safe.pm
    $msg =~ s/$eval \d+$/XXX/i; # uses IsDigit SWASH
    push @warns, $msg;
};

is eval { $sub->() }, 1, 'warn should return 1';
is $@, '', '__WARN__ hook should not die';
is @warns, 1, 'should only be 1 warning';
like $warns[0], qr/at XXX line/, 'warning should have been edited';