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