1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#!./perl
# Test the Internal::* functions and other tibits in universal.c
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require './test.pl';
plan( tests => 13 );
}
for my $arg ('', 'q[]', qw( 1 undef )) {
fresh_perl_is(<<"----", <<'====', "Internals::* functions check their argument under func() AND &func() [perl #77776]");
sub tryit { eval shift or warn \$@ }
tryit "&Internals::SvREADONLY($arg)";
tryit "&Internals::SvREFCNT($arg)";
tryit "&Internals::hv_clear_placeholders($arg)";
tryit "&Internals::HvREHASH($arg)";
----
Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
Internals::HvREHASH $hashref at (eval 4) line 1.
====
}
# Various conundrums with SvREADONLY
$x = *foo;
Internals::SvREADONLY $x, 1;
ok Internals::SvREADONLY($x),
'read-only glob copies are read-only acc. to Internals::';
eval { $x = [] };
like $@, qr/Modification of a read-only value attempted at/,
'read-only glob copies';
Internals::SvREADONLY($x,0);
$x = 42;
is $x, 42, 'Internals::SvREADONLY can turn off readonliness on globs';
# Same thing with regexps
$x = ${qr//};
Internals::SvREADONLY $x, 1;
ok Internals::SvREADONLY($x),
'read-only regexps are read-only acc. to Internals::';
eval { $x = [] };
like $@, qr/Modification of a read-only value attempted at/,
'read-only regexps';
Internals::SvREADONLY($x,0);
$x = 42;
is $x, 42, 'Internals::SvREADONLY can turn off readonliness on regexps';
$h{a} = __PACKAGE__;
Internals::SvREADONLY $h{a}, 1;
eval { $h{a} = 3 };
like $@, qr/Modification of a read-only value attempted at/,
'making a COW scalar into a read-only one';
$h{b} = __PACKAGE__;
ok !Internals::SvREADONLY($h{b}),
'cows are not read-only acc. to Internals::';
Internals::SvREADONLY($h{b},0);
$h{b} =~ y/ia/ao/;
is __PACKAGE__, 'main',
'turning off a cow’s readonliness did not affect sharers of the same PV';
|
