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