[perl #121159] use the updated win32_popenlist() even with USE_IMP_SYS
[perl.git] / lib / Internals.t
1 #!/usr/bin/perl -Tw
2
3 BEGIN {
4     if( $ENV{PERL_CORE} ) {
5         @INC = '../lib';
6         chdir 't';
7     }
8 }
9
10 use Test::More tests => 82;
11
12 my $ro_err = qr/^Modification of a read-only value attempted/;
13
14 ### Read-only scalar
15 my $foo;
16
17 ok( !Internals::SvREADONLY $foo );
18 $foo = 3;
19 is($foo, 3);
20
21 ok(  Internals::SvREADONLY $foo, 1 );
22 ok(  Internals::SvREADONLY $foo );
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
29 ok( !Internals::SvREADONLY $foo, 0 );
30 ok( !Internals::SvREADONLY $foo );
31 $foo = 'foo';
32 is($foo, 'foo');
33
34 ### Read-only array
35 my @foo;
36
37 ok( !Internals::SvREADONLY @foo );
38 @foo = (1..3);
39 is(scalar(@foo), 3);
40 is($foo[2], 3);
41
42 ok(  Internals::SvREADONLY @foo, 1 );
43 ok(  Internals::SvREADONLY @foo );
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
55 ok( !Internals::SvREADONLY @foo, 0 );
56 ok( !Internals::SvREADONLY @foo );
57 eval { @foo = qw/foo bar/; };
58 is(scalar(@foo), 2);
59 is($foo[1], 'bar');
60
61 ### Read-only array element
62
63 ok( !Internals::SvREADONLY $foo[2] );
64 $foo[2] = 'baz';
65 is($foo[2], 'baz');
66
67 ok(  Internals::SvREADONLY $foo[2], 1 );
68 ok(  Internals::SvREADONLY $foo[2] );
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
97 ok( !Internals::SvREADONLY $foo[2], 0 );
98 ok( !Internals::SvREADONLY $foo[2] );
99 $foo[2] = 'xyzzy';
100 is($foo[2], 'xyzzy');
101
102 ### Read-only hash
103 my %foo;
104
105 ok( !Internals::SvREADONLY %foo );
106 %foo = ('foo' => 1, 2 => 'bar');
107 is(scalar(keys(%foo)), 2);
108 is($foo{'foo'}, 1);
109
110 ok(  Internals::SvREADONLY %foo, 1 );
111 ok(  Internals::SvREADONLY %foo );
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
131 ok( !Internals::SvREADONLY %foo, 0 );
132 ok( !Internals::SvREADONLY %foo );
133
134 ### Read-only hash values
135
136 ok( !Internals::SvREADONLY $foo{foo} );
137 $foo{'foo'} = 'bar';
138 is($foo{'foo'}, 'bar');
139
140 ok(  Internals::SvREADONLY $foo{foo}, 1 );
141 ok(  Internals::SvREADONLY $foo{foo} );
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
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
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
166 is(  Internals::SvREFCNT($foo, 2), 2, "update ref count");
167 is(  Internals::SvREFCNT($foo), 2, "check we got the stored value");
168
169 # the reference count is a U16, but was returned as an IV resulting in
170 # different values between 32 and 64-bit builds
171 my $big_count = 0xFFFFFFF0; # -16 32-bit signed
172 is( Internals::SvREFCNT($foo, $big_count), $big_count,
173     "set reference count unsigned");
174 is( Internals::SvREFCNT($foo), $big_count, "reference count unsigned");
175
176 {
177     my @arr = Internals::SvREFCNT($foo, 1 );
178     is(scalar(@arr), 1, "SvREFCNT always returns only 1 item");
179 }
180
181 {
182     my $usage =  'Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT])';
183     eval { &Internals::SvREFCNT();};
184     like($@, qr/\Q$usage\E/);
185     $foo = \"perl";
186     eval { &Internals::SvREFCNT($foo, 0..1);};
187     like($@, qr/\Q$usage\E/);
188     eval { &Internals::SvREFCNT($foo, 0..3);};
189     like($@, qr/\Q$usage\E/);
190 }