This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[rt #103222] make Internals::SvREFCNT set/get consistent
[perl5.git] / lib / Internals.t
CommitLineData
29569577
JH
1#!/usr/bin/perl -Tw
2
3BEGIN {
4 if( $ENV{PERL_CORE} ) {
5 @INC = '../lib';
6 chdir 't';
7 }
8}
9
28884311 10use Test::More tests => 76;
29569577 11
6ba53697
JH
12my $ro_err = qr/^Modification of a read-only value attempted/;
13
14### Read-only scalar
29569577
JH
15my $foo;
16
17ok( !Internals::SvREADONLY $foo );
6ba53697
JH
18$foo = 3;
19is($foo, 3);
20
29569577
JH
21ok( Internals::SvREADONLY $foo, 1 );
22ok( Internals::SvREADONLY $foo );
6ba53697
JH
23eval { $foo = 'foo'; };
24like($@, $ro_err, q/Can't modify read-only scalar/);
25eval { undef($foo); };
26like($@, $ro_err, q/Can't undef read-only scalar/);
27is($foo, 3);
28
29569577
JH
29ok( !Internals::SvREADONLY $foo, 0 );
30ok( !Internals::SvREADONLY $foo );
6ba53697
JH
31$foo = 'foo';
32is($foo, 'foo');
33
34### Read-only array
35my @foo;
29569577
JH
36
37ok( !Internals::SvREADONLY @foo );
6ba53697
JH
38@foo = (1..3);
39is(scalar(@foo), 3);
40is($foo[2], 3);
41
29569577
JH
42ok( Internals::SvREADONLY @foo, 1 );
43ok( Internals::SvREADONLY @foo );
6ba53697
JH
44eval { undef(@foo); };
45like($@, $ro_err, q/Can't undef read-only array/);
46eval { delete($foo[2]); };
47like($@, $ro_err, q/Can't delete from read-only array/);
48eval { shift(@foo); };
49like($@, $ro_err, q/Can't shift read-only array/);
50eval { push(@foo, 'bork'); };
51like($@, $ro_err, q/Can't push onto read-only array/);
52eval { @foo = qw/foo bar/; };
53like($@, $ro_err, q/Can't reassign read-only array/);
54
29569577
JH
55ok( !Internals::SvREADONLY @foo, 0 );
56ok( !Internals::SvREADONLY @foo );
6ba53697
JH
57eval { @foo = qw/foo bar/; };
58is(scalar(@foo), 2);
59is($foo[1], 'bar');
60
61### Read-only array element
29569577
JH
62
63ok( !Internals::SvREADONLY $foo[2] );
6ba53697
JH
64$foo[2] = 'baz';
65is($foo[2], 'baz');
66
29569577
JH
67ok( Internals::SvREADONLY $foo[2], 1 );
68ok( Internals::SvREADONLY $foo[2] );
6ba53697
JH
69
70$foo[0] = 99;
71is($foo[0], 99, 'Rest of array still modifiable');
72
73shift(@foo);
74ok( Internals::SvREADONLY $foo[1] );
75eval { $foo[1] = 'bork'; };
76like($@, $ro_err, 'Read-only array element moved');
77is($foo[1], 'baz');
78
79ok( !Internals::SvREADONLY $foo[2] );
80$foo[2] = 'qux';
81is($foo[2], 'qux');
82
83unshift(@foo, 'foo');
84ok( !Internals::SvREADONLY $foo[1] );
85ok( Internals::SvREADONLY $foo[2] );
86
87eval { $foo[2] = 86; };
88like($@, $ro_err, q/Can't modify read-only array element/);
89eval { undef($foo[2]); };
90like($@, $ro_err, q/Can't undef read-only array element/);
91TODO: {
92 local $TODO = 'Due to restricted hashes implementation';
93 eval { delete($foo[2]); };
94 like($@, $ro_err, q/Can't delete read-only array element/);
95}
96
29569577
JH
97ok( !Internals::SvREADONLY $foo[2], 0 );
98ok( !Internals::SvREADONLY $foo[2] );
6ba53697
JH
99$foo[2] = 'xyzzy';
100is($foo[2], 'xyzzy');
101
102### Read-only hash
103my %foo;
29569577
JH
104
105ok( !Internals::SvREADONLY %foo );
6ba53697
JH
106%foo = ('foo' => 1, 2 => 'bar');
107is(scalar(keys(%foo)), 2);
108is($foo{'foo'}, 1);
109
29569577
JH
110ok( Internals::SvREADONLY %foo, 1 );
111ok( Internals::SvREADONLY %foo );
6ba53697
JH
112eval { undef(%foo); };
113like($@, $ro_err, q/Can't undef read-only hash/);
114TODO: {
115 local $TODO = 'Due to restricted hashes implementation';
116 eval { %foo = ('ping' => 'pong'); };
117 like($@, $ro_err, q/Can't modify read-only hash/);
118}
119eval { $foo{'baz'} = 123; };
120like($@, qr/Attempt to access disallowed key/, q/Can't add to a read-only hash/);
121
122# These ops are allow for Hash::Util functionality
123$foo{2} = 'qux';
124is($foo{2}, 'qux', 'Can modify elements in a read-only hash');
125my $qux = delete($foo{2});
126ok(! exists($foo{2}), 'Can delete keys from a read-only hash');
127is($qux, 'qux');
128$foo{2} = 2;
129is($foo{2}, 2, 'Can add back deleted keys in a read-only hash');
130
29569577
JH
131ok( !Internals::SvREADONLY %foo, 0 );
132ok( !Internals::SvREADONLY %foo );
133
6ba53697
JH
134### Read-only hash values
135
29569577 136ok( !Internals::SvREADONLY $foo{foo} );
6ba53697
JH
137$foo{'foo'} = 'bar';
138is($foo{'foo'}, 'bar');
139
29569577
JH
140ok( Internals::SvREADONLY $foo{foo}, 1 );
141ok( Internals::SvREADONLY $foo{foo} );
6ba53697
JH
142eval { $foo{'foo'} = 88; };
143like($@, $ro_err, q/Can't modify a read-only hash value/);
144eval { undef($foo{'foo'}); };
145like($@, $ro_err, q/Can't undef a read-only hash value/);
146my $bar = delete($foo{'foo'});
147ok(! exists($foo{'foo'}), 'Can delete a read-only hash value');
148is($bar, 'bar');
149
29569577
JH
150ok( !Internals::SvREADONLY $foo{foo}, 0 );
151ok( !Internals::SvREADONLY $foo{foo} );
152
153is( Internals::SvREFCNT($foo), 1 );
154{
155 my $bar = \$foo;
156 is( Internals::SvREFCNT($foo), 2 );
157 is( Internals::SvREFCNT($bar), 1 );
158}
159is( Internals::SvREFCNT($foo), 1 );
160
14a976d6
JH
161is( Internals::SvREFCNT(@foo), 1 );
162is( Internals::SvREFCNT($foo[2]), 1 );
163is( Internals::SvREFCNT(%foo), 1 );
164is( Internals::SvREFCNT($foo{foo}), 1 );
165
28884311
TC
166is( Internals::SvREFCNT($foo, 2), 2, "update ref count");
167is( Internals::SvREFCNT($foo), 2, "check we got the stored value");
168
169Internals::SvREFCNT($foo, 1 );