1898184e3Ssthen#!./perl 2898184e3Ssthen 3898184e3Ssthen# Test the Internal::* functions and other tibits in universal.c 4898184e3Ssthen 5898184e3SsthenBEGIN { 6898184e3Ssthen chdir 't' if -d 't'; 7898184e3Ssthen @INC = '../lib'; 8898184e3Ssthen require './test.pl'; 9*b8851fccSafresh1 plan( tests => 17 ); 10898184e3Ssthen} 11898184e3Ssthen 12898184e3Ssthenfor my $arg ('', 'q[]', qw( 1 undef )) { 136fb12b70Safresh1 fresh_perl_is(<<"----", <<'====', {}, "Internals::* functions check their argument under func() AND &func() [perl #77776]"); 14898184e3Ssthensub tryit { eval shift or warn \$@ } 15898184e3Ssthentryit "&Internals::SvREADONLY($arg)"; 16898184e3Ssthentryit "&Internals::SvREFCNT($arg)"; 17898184e3Ssthentryit "&Internals::hv_clear_placeholders($arg)"; 18898184e3Ssthen---- 19898184e3SsthenUsage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1. 20898184e3SsthenUsage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1. 21898184e3SsthenUsage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1. 22898184e3Ssthen==== 23898184e3Ssthen} 24898184e3Ssthen 25898184e3Ssthen# Various conundrums with SvREADONLY 26898184e3Ssthen 27898184e3Ssthen$x = *foo; 28898184e3SsthenInternals::SvREADONLY $x, 1; 29898184e3Ssthenok Internals::SvREADONLY($x), 30898184e3Ssthen 'read-only glob copies are read-only acc. to Internals::'; 31898184e3Sstheneval { $x = [] }; 32898184e3Ssthenlike $@, qr/Modification of a read-only value attempted at/, 33898184e3Ssthen 'read-only glob copies'; 34898184e3SsthenInternals::SvREADONLY($x,0); 35898184e3Ssthen$x = 42; 36898184e3Ssthenis $x, 42, 'Internals::SvREADONLY can turn off readonliness on globs'; 37898184e3Ssthen 38898184e3Ssthen# Same thing with regexps 39898184e3Ssthen$x = ${qr//}; 40898184e3SsthenInternals::SvREADONLY $x, 1; 41898184e3Ssthenok Internals::SvREADONLY($x), 42898184e3Ssthen 'read-only regexps are read-only acc. to Internals::'; 43898184e3Sstheneval { $x = [] }; 44898184e3Ssthenlike $@, qr/Modification of a read-only value attempted at/, 45898184e3Ssthen 'read-only regexps'; 46898184e3SsthenInternals::SvREADONLY($x,0); 47898184e3Ssthen$x = 42; 48898184e3Ssthenis $x, 42, 'Internals::SvREADONLY can turn off readonliness on regexps'; 49898184e3Ssthen 50898184e3Ssthen$h{a} = __PACKAGE__; 51898184e3SsthenInternals::SvREADONLY $h{a}, 1; 52898184e3Sstheneval { $h{a} = 3 }; 53898184e3Ssthenlike $@, qr/Modification of a read-only value attempted at/, 54898184e3Ssthen 'making a COW scalar into a read-only one'; 55898184e3Ssthen 56898184e3Ssthen$h{b} = __PACKAGE__; 57898184e3Ssthenok !Internals::SvREADONLY($h{b}), 58898184e3Ssthen 'cows are not read-only acc. to Internals::'; 59898184e3SsthenInternals::SvREADONLY($h{b},0); 60898184e3Ssthen$h{b} =~ y/ia/ao/; 61898184e3Ssthenis __PACKAGE__, 'main', 62*b8851fccSafresh1 'turning off a cow\'s readonliness did not affect sharers of the same PV'; 63*b8851fccSafresh1 64*b8851fccSafresh1&Internals::SvREADONLY(\!0, 0); 65*b8851fccSafresh1eval { ${\!0} = 7 }; 66*b8851fccSafresh1like $@, qr "^Modification of a read-only value", 67*b8851fccSafresh1 'protected values still croak on assignment after SvREADONLY(..., 0)'; 68*b8851fccSafresh1is ${\3} == 3, "1", 'attempt to modify failed'; 69*b8851fccSafresh1 70*b8851fccSafresh1eval { { my $x = ${qr//}; Internals::SvREADONLY $x, 1; () } }; 71*b8851fccSafresh1is $@, "", 'read-only lexical regexps on scope exit [perl #115254]'; 72*b8851fccSafresh1 73*b8851fccSafresh1Internals::SvREADONLY($],0); 74*b8851fccSafresh1eval { $]=7 }; 75*b8851fccSafresh1is $], 7, 'SvREADONLY can make magic vars mutable' 76