code.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
#
# Copyright (c) 2002 Slaven Rezic
#
# You may redistribute only under the same terms as Perl 5, as specified
# in the README file that comes with the distribution.
#
sub BEGIN {
chdir('t') if -d 't';
} else {
}
print "1..0 # Skip: Storable was not built\n";
exit 0;
}
}
use strict;
BEGIN {
if (!eval q{
use Test;
use B::Deparse 0.61;
use 5.006;
1;
}) {
print "1..0 # skip: tests only work with B::Deparse 0.61 and at least perl 5.6.0\n";
exit;
}
print "1..0 # Skip: newer File::Spec needed\n";
exit 0;
}
}
use Safe;
#$Storable::DEBUGME = 1;
{ package Another::Package; sub foo { __PACKAGE__ } }
{
}
local *FOO;
@obj =
sub { 6*7 },
$blessed_code, # blessed code reference
sub ($$;$) { 0 }, # prototypes
sub { print "test\n" },
],
\&code,
\&dclone, # XS function
);
######################################################################
# Test freeze & thaw
######################################################################
######################################################################
######################################################################
######################################################################
######################################################################
# Test dclone
######################################################################
# Test retrieve & store
######################################################################
######################################################################
# Security with
# $Storable::Eval
# $Storable::Deparse
{
for my $i (0 .. 1) {
$@ = "";
}
}
{
for my $i (0 .. 1) {
$@ = "";
}
}
{
local $Storable::forgive_me = 1;
for my $i (0 .. 4) {
$@ = "";
}
}
{
local $Storable::forgive_me = 1;
}
{
$@ = "";
# The "Code sub ..." error message only appears if Log::Agent is installed
if (0) {
# Disable or fix this test if the internal representation of Storable
# changes.
} else {
# Construct malicious storable code
# 5th byte is (short) length of scalar
$@ = "";
}
}
{
# because of opcodes used in "use strict":
$@ = "";
}
{
{
sub reval {
my $source = $_[1];
# Here you can apply some nifty regexpes to ensure the
# safeness of the source code.
}
}
} else {
}
}
{
# Check internal "seen" code
# for SX_LSCALAR
my $long_sub = eval $long_sub_code; die $@ if $@;
my $sclr = \1;
my $res;
}
}