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'; | |
57c404c9 | 9 | plan( tests => 16 ); |
80b6a949 AB |
10 | } |
11 | ||
12 | for my $arg ('', 'q[]', qw( 1 undef )) { | |
20e5bab4 | 13 | fresh_perl_is(<<"----", <<'====', {}, "Internals::* functions check their argument under func() AND &func() [perl #77776]"); |
80b6a949 AB |
14 | sub tryit { eval shift or warn \$@ } |
15 | tryit "&Internals::SvREADONLY($arg)"; | |
16 | tryit "&Internals::SvREFCNT($arg)"; | |
17 | tryit "&Internals::hv_clear_placeholders($arg)"; | |
80b6a949 AB |
18 | ---- |
19 | Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1. | |
20 | Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1. | |
21 | Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1. | |
80b6a949 AB |
22 | ==== |
23 | } | |
21690b72 FC |
24 | |
25 | # Various conundrums with SvREADONLY | |
26 | ||
27 | $x = *foo; | |
28 | Internals::SvREADONLY $x, 1; | |
3e89ba19 FC |
29 | ok Internals::SvREADONLY($x), |
30 | 'read-only glob copies are read-only acc. to Internals::'; | |
21690b72 FC |
31 | eval { $x = [] }; |
32 | like $@, qr/Modification of a read-only value attempted at/, | |
33 | 'read-only glob copies'; | |
3e89ba19 FC |
34 | Internals::SvREADONLY($x,0); |
35 | $x = 42; | |
36 | is $x, 42, 'Internals::SvREADONLY can turn off readonliness on globs'; | |
37 | ||
3a482d8d FC |
38 | # Same thing with regexps |
39 | $x = ${qr//}; | |
40 | Internals::SvREADONLY $x, 1; | |
41 | ok Internals::SvREADONLY($x), | |
42 | 'read-only regexps are read-only acc. to Internals::'; | |
43 | eval { $x = [] }; | |
44 | like $@, qr/Modification of a read-only value attempted at/, | |
45 | 'read-only regexps'; | |
46 | Internals::SvREADONLY($x,0); | |
47 | $x = 42; | |
48 | is $x, 42, 'Internals::SvREADONLY can turn off readonliness on regexps'; | |
49 | ||
3e89ba19 FC |
50 | $h{a} = __PACKAGE__; |
51 | Internals::SvREADONLY $h{a}, 1; | |
52 | eval { $h{a} = 3 }; | |
53 | like $@, qr/Modification of a read-only value attempted at/, | |
54 | 'making a COW scalar into a read-only one'; | |
55 | ||
56 | $h{b} = __PACKAGE__; | |
57 | ok !Internals::SvREADONLY($h{b}), | |
58 | 'cows are not read-only acc. to Internals::'; | |
59 | Internals::SvREADONLY($h{b},0); | |
60 | $h{b} =~ y/ia/ao/; | |
61 | is __PACKAGE__, 'main', | |
62 | 'turning off a cow’s readonliness did not affect sharers of the same PV'; | |
a623f893 FC |
63 | |
64 | &Internals::SvREADONLY(\!0, 0); | |
65 | eval { ${\!0} = 7 }; | |
66 | like $@, qr "^Modification of a read-only value", | |
67 | 'protected values still croak on assignment after SvREADONLY(..., 0)'; | |
68 | is ${\3} == 3, "1", 'attempt to modify failed'; | |
57c404c9 FC |
69 | |
70 | eval { { my $x = ${qr//}; Internals::SvREADONLY $x, 1; () } }; | |
71 | is $@, "", 'read-only lexical regexps on scope exit [perl #115254]'; |