Commit | Line | Data |
---|---|---|
29569577 JH |
1 | #!/usr/bin/perl -Tw |
2 | ||
3 | BEGIN { | |
4 | if( $ENV{PERL_CORE} ) { | |
5 | @INC = '../lib'; | |
6 | chdir 't'; | |
7 | } | |
8 | } | |
9 | ||
6ba53697 | 10 | use Test::More tests => 74; |
29569577 | 11 | |
6ba53697 JH |
12 | my $ro_err = qr/^Modification of a read-only value attempted/; |
13 | ||
14 | ### Read-only scalar | |
29569577 JH |
15 | my $foo; |
16 | ||
17 | ok( !Internals::SvREADONLY $foo ); | |
6ba53697 JH |
18 | $foo = 3; |
19 | is($foo, 3); | |
20 | ||
29569577 JH |
21 | ok( Internals::SvREADONLY $foo, 1 ); |
22 | ok( Internals::SvREADONLY $foo ); | |
6ba53697 JH |
23 | eval { $foo = 'foo'; }; |
24 | like($@, $ro_err, q/Can't modify read-only scalar/); | |
25 | eval { undef($foo); }; | |
26 | like($@, $ro_err, q/Can't undef read-only scalar/); | |
27 | is($foo, 3); | |
28 | ||
29569577 JH |
29 | ok( !Internals::SvREADONLY $foo, 0 ); |
30 | ok( !Internals::SvREADONLY $foo ); | |
6ba53697 JH |
31 | $foo = 'foo'; |
32 | is($foo, 'foo'); | |
33 | ||
34 | ### Read-only array | |
35 | my @foo; | |
29569577 JH |
36 | |
37 | ok( !Internals::SvREADONLY @foo ); | |
6ba53697 JH |
38 | @foo = (1..3); |
39 | is(scalar(@foo), 3); | |
40 | is($foo[2], 3); | |
41 | ||
29569577 JH |
42 | ok( Internals::SvREADONLY @foo, 1 ); |
43 | ok( Internals::SvREADONLY @foo ); | |
6ba53697 JH |
44 | eval { undef(@foo); }; |
45 | like($@, $ro_err, q/Can't undef read-only array/); | |
46 | eval { delete($foo[2]); }; | |
47 | like($@, $ro_err, q/Can't delete from read-only array/); | |
48 | eval { shift(@foo); }; | |
49 | like($@, $ro_err, q/Can't shift read-only array/); | |
50 | eval { push(@foo, 'bork'); }; | |
51 | like($@, $ro_err, q/Can't push onto read-only array/); | |
52 | eval { @foo = qw/foo bar/; }; | |
53 | like($@, $ro_err, q/Can't reassign read-only array/); | |
54 | ||
29569577 JH |
55 | ok( !Internals::SvREADONLY @foo, 0 ); |
56 | ok( !Internals::SvREADONLY @foo ); | |
6ba53697 JH |
57 | eval { @foo = qw/foo bar/; }; |
58 | is(scalar(@foo), 2); | |
59 | is($foo[1], 'bar'); | |
60 | ||
61 | ### Read-only array element | |
29569577 JH |
62 | |
63 | ok( !Internals::SvREADONLY $foo[2] ); | |
6ba53697 JH |
64 | $foo[2] = 'baz'; |
65 | is($foo[2], 'baz'); | |
66 | ||
29569577 JH |
67 | ok( Internals::SvREADONLY $foo[2], 1 ); |
68 | ok( Internals::SvREADONLY $foo[2] ); | |
6ba53697 JH |
69 | |
70 | $foo[0] = 99; | |
71 | is($foo[0], 99, 'Rest of array still modifiable'); | |
72 | ||
73 | shift(@foo); | |
74 | ok( Internals::SvREADONLY $foo[1] ); | |
75 | eval { $foo[1] = 'bork'; }; | |
76 | like($@, $ro_err, 'Read-only array element moved'); | |
77 | is($foo[1], 'baz'); | |
78 | ||
79 | ok( !Internals::SvREADONLY $foo[2] ); | |
80 | $foo[2] = 'qux'; | |
81 | is($foo[2], 'qux'); | |
82 | ||
83 | unshift(@foo, 'foo'); | |
84 | ok( !Internals::SvREADONLY $foo[1] ); | |
85 | ok( Internals::SvREADONLY $foo[2] ); | |
86 | ||
87 | eval { $foo[2] = 86; }; | |
88 | like($@, $ro_err, q/Can't modify read-only array element/); | |
89 | eval { undef($foo[2]); }; | |
90 | like($@, $ro_err, q/Can't undef read-only array element/); | |
91 | TODO: { | |
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 |
97 | ok( !Internals::SvREADONLY $foo[2], 0 ); |
98 | ok( !Internals::SvREADONLY $foo[2] ); | |
6ba53697 JH |
99 | $foo[2] = 'xyzzy'; |
100 | is($foo[2], 'xyzzy'); | |
101 | ||
102 | ### Read-only hash | |
103 | my %foo; | |
29569577 JH |
104 | |
105 | ok( !Internals::SvREADONLY %foo ); | |
6ba53697 JH |
106 | %foo = ('foo' => 1, 2 => 'bar'); |
107 | is(scalar(keys(%foo)), 2); | |
108 | is($foo{'foo'}, 1); | |
109 | ||
29569577 JH |
110 | ok( Internals::SvREADONLY %foo, 1 ); |
111 | ok( Internals::SvREADONLY %foo ); | |
6ba53697 JH |
112 | eval { undef(%foo); }; |
113 | like($@, $ro_err, q/Can't undef read-only hash/); | |
114 | TODO: { | |
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 | } | |
119 | eval { $foo{'baz'} = 123; }; | |
120 | like($@, 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'; | |
124 | is($foo{2}, 'qux', 'Can modify elements in a read-only hash'); | |
125 | my $qux = delete($foo{2}); | |
126 | ok(! exists($foo{2}), 'Can delete keys from a read-only hash'); | |
127 | is($qux, 'qux'); | |
128 | $foo{2} = 2; | |
129 | is($foo{2}, 2, 'Can add back deleted keys in a read-only hash'); | |
130 | ||
29569577 JH |
131 | ok( !Internals::SvREADONLY %foo, 0 ); |
132 | ok( !Internals::SvREADONLY %foo ); | |
133 | ||
6ba53697 JH |
134 | ### Read-only hash values |
135 | ||
29569577 | 136 | ok( !Internals::SvREADONLY $foo{foo} ); |
6ba53697 JH |
137 | $foo{'foo'} = 'bar'; |
138 | is($foo{'foo'}, 'bar'); | |
139 | ||
29569577 JH |
140 | ok( Internals::SvREADONLY $foo{foo}, 1 ); |
141 | ok( Internals::SvREADONLY $foo{foo} ); | |
6ba53697 JH |
142 | eval { $foo{'foo'} = 88; }; |
143 | like($@, $ro_err, q/Can't modify a read-only hash value/); | |
144 | eval { undef($foo{'foo'}); }; | |
145 | like($@, $ro_err, q/Can't undef a read-only hash value/); | |
146 | my $bar = delete($foo{'foo'}); | |
147 | ok(! exists($foo{'foo'}), 'Can delete a read-only hash value'); | |
148 | is($bar, 'bar'); | |
149 | ||
29569577 JH |
150 | ok( !Internals::SvREADONLY $foo{foo}, 0 ); |
151 | ok( !Internals::SvREADONLY $foo{foo} ); | |
152 | ||
153 | is( Internals::SvREFCNT($foo), 1 ); | |
154 | { | |
155 | my $bar = \$foo; | |
156 | is( Internals::SvREFCNT($foo), 2 ); | |
157 | is( Internals::SvREFCNT($bar), 1 ); | |
158 | } | |
159 | is( Internals::SvREFCNT($foo), 1 ); | |
160 | ||
14a976d6 JH |
161 | is( Internals::SvREFCNT(@foo), 1 ); |
162 | is( Internals::SvREFCNT($foo[2]), 1 ); | |
163 | is( Internals::SvREFCNT(%foo), 1 ); | |
164 | is( Internals::SvREFCNT($foo{foo}), 1 ); | |
165 |