164 lines
4.3 KiB
Perl
164 lines
4.3 KiB
Perl
#!/usr/bin/perl -Tw
|
|
|
|
BEGIN {
|
|
if( %ENV{PERL_CORE} ) {
|
|
@INC = '../lib';
|
|
chdir 't';
|
|
}
|
|
}
|
|
|
|
use Test::More tests => 74;
|
|
|
|
my $ro_err = qr/^Modification of a read-only value attempted/;
|
|
|
|
### Read-only scalar
|
|
my $foo;
|
|
|
|
ok( !Internals::SvREADONLY $foo );
|
|
$foo = 3;
|
|
is($foo, 3);
|
|
|
|
ok( Internals::SvREADONLY $foo, 1 );
|
|
ok( Internals::SvREADONLY $foo );
|
|
eval { $foo = 'foo'; };
|
|
like($@->message, $ro_err, q/Can't modify read-only scalar/);
|
|
eval { undef($foo); };
|
|
like($@->message, $ro_err, q/Can't undef read-only scalar/);
|
|
is($foo, 3);
|
|
|
|
ok( !Internals::SvREADONLY $foo, 0 );
|
|
ok( !Internals::SvREADONLY $foo );
|
|
$foo = 'foo';
|
|
is($foo, 'foo');
|
|
|
|
### Read-only array
|
|
my @foo;
|
|
|
|
ok( !Internals::SvREADONLY @foo );
|
|
@foo = (1..3);
|
|
is(scalar(@foo), 3);
|
|
is(@foo[2], 3);
|
|
|
|
ok( Internals::SvREADONLY @foo, 1 );
|
|
ok( Internals::SvREADONLY @foo );
|
|
eval { undef(@foo); };
|
|
like($@->message, $ro_err, q/Can't undef read-only array/);
|
|
eval { delete(@foo[2]); };
|
|
like($@->message, $ro_err, q/Can't delete from read-only array/);
|
|
eval { shift(@foo); };
|
|
like($@->message, $ro_err, q/Can't shift read-only array/);
|
|
eval { push(@foo, 'bork'); };
|
|
like($@->message, $ro_err, q/Can't push onto read-only array/);
|
|
eval { @foo = qw/foo bar/; };
|
|
like($@->message, $ro_err, q/Can't reassign read-only array/);
|
|
|
|
ok( !Internals::SvREADONLY @foo, 0 );
|
|
ok( !Internals::SvREADONLY @foo );
|
|
eval { @foo = qw/foo bar/; };
|
|
is(scalar(@foo), 2);
|
|
is(@foo[1], 'bar');
|
|
|
|
### Read-only array element
|
|
|
|
ok( !Internals::SvREADONLY @foo[2] );
|
|
@foo[2] = 'baz';
|
|
is(@foo[2], 'baz');
|
|
|
|
ok( Internals::SvREADONLY @foo[2], 1 );
|
|
ok( Internals::SvREADONLY @foo[2] );
|
|
|
|
@foo[0] = 99;
|
|
is(@foo[0], 99, 'Rest of array still modifiable');
|
|
|
|
shift(@foo);
|
|
ok( Internals::SvREADONLY @foo[1] );
|
|
eval { @foo[1] = 'bork'; };
|
|
like($@->message, $ro_err, 'Read-only array element moved');
|
|
is(@foo[1], 'baz');
|
|
|
|
ok( !Internals::SvREADONLY @foo[2] );
|
|
@foo[2] = 'qux';
|
|
is(@foo[2], 'qux');
|
|
|
|
unshift(@foo, 'foo');
|
|
ok( !Internals::SvREADONLY @foo[1] );
|
|
ok( Internals::SvREADONLY @foo[2] );
|
|
|
|
eval { @foo[2] = 86; };
|
|
like($@->message, $ro_err, q/Can't modify read-only array element/);
|
|
eval { undef(@foo[2]); };
|
|
like($@->message, $ro_err, q/Can't undef read-only array element/);
|
|
TODO: {
|
|
local $TODO = 'Due to restricted hashes implementation';
|
|
eval { delete(@foo[2]); };
|
|
like($@ && $@->message, $ro_err, q/Can't delete read-only array element/);
|
|
}
|
|
|
|
ok( !Internals::SvREADONLY @foo[2], 0 );
|
|
ok( !Internals::SvREADONLY @foo[2] );
|
|
@foo[2] = 'xyzzy';
|
|
is(@foo[2], 'xyzzy');
|
|
|
|
### Read-only hash
|
|
my %foo;
|
|
|
|
ok( !Internals::SvREADONLY %foo );
|
|
%foo = ('foo' => 1, 2 => 'bar');
|
|
is(scalar(keys(%foo)), 2);
|
|
is(%foo{'foo'}, 1);
|
|
|
|
ok( Internals::SvREADONLY %foo, 1 );
|
|
ok( Internals::SvREADONLY %foo );
|
|
eval { undef(%foo); };
|
|
like($@->message, $ro_err, q/Can't undef read-only hash/);
|
|
TODO: {
|
|
local $TODO = 'Due to restricted hashes implementation';
|
|
eval { %foo = ('ping' => 'pong'); };
|
|
like($@->message, $ro_err, q/Can't modify read-only hash/);
|
|
}
|
|
eval { %foo{'baz'} = 123; };
|
|
like($@->message, qr/Attempt to access disallowed key/, q/Can't add to a read-only hash/);
|
|
|
|
# These ops are allow for Hash::Util functionality
|
|
%foo{2} = 'qux';
|
|
is(%foo{2}, 'qux', 'Can modify elements in a read-only hash');
|
|
my $qux = delete(%foo{2});
|
|
ok(! exists(%foo{2}), 'Can delete keys from a read-only hash');
|
|
is($qux, 'qux');
|
|
%foo{2} = 2;
|
|
is(%foo{2}, 2, 'Can add back deleted keys in a read-only hash');
|
|
|
|
ok( !Internals::SvREADONLY %foo, 0 );
|
|
ok( !Internals::SvREADONLY %foo );
|
|
|
|
### Read-only hash values
|
|
|
|
ok( !Internals::SvREADONLY %foo{foo} );
|
|
%foo{'foo'} = 'bar';
|
|
is(%foo{'foo'}, 'bar');
|
|
|
|
ok( Internals::SvREADONLY %foo{foo}, 1 );
|
|
ok( Internals::SvREADONLY %foo{foo} );
|
|
eval { %foo{'foo'} = 88; };
|
|
like($@->message, $ro_err, q/Can't modify a read-only hash value/);
|
|
eval { undef(%foo{'foo'}); };
|
|
like($@->message, $ro_err, q/Can't undef a read-only hash value/);
|
|
my $bar = delete(%foo{'foo'});
|
|
ok(! exists(%foo{'foo'}), 'Can delete a read-only hash value');
|
|
is($bar, 'bar');
|
|
|
|
ok( !Internals::SvREADONLY %foo{foo}, 0 );
|
|
ok( !Internals::SvREADONLY %foo{foo} );
|
|
|
|
is( Internals::SvREFCNT(\$foo), 2 );
|
|
{
|
|
my $bar = \$foo;
|
|
is( Internals::SvREFCNT(\$foo), 3 );
|
|
is( Internals::SvREFCNT(\$bar), 2 );
|
|
}
|
|
is( Internals::SvREFCNT(\$foo), 2 );
|
|
|
|
is( Internals::SvREFCNT(\@foo), 2 );
|
|
is( Internals::SvREFCNT(\@foo[2]), 2 );
|
|
is( Internals::SvREFCNT(\%foo), 2 );
|
|
is( Internals::SvREFCNT(\%foo{foo}), 2 );
|