Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
Devel	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
charnames	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
croak	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
deprecate	[ DIR ]	drwxr-xr-x	2016-10-10 18:14
feature	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
locale	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
strict	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
subs	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
warnings	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
1_compile.t	1.64 KB	-r--r--r--	2014-12-27 11:49
Cname.pm	934 B	-r--r--r--	2014-12-27 11:49
Count.pm	107 B	-r--r--r--	2014-12-27 11:49
Sans_mypragma.pm	72 B	-r--r--r--	2014-12-27 11:49
common.pl	1.37 KB	-r--r--r--	2014-12-27 11:49
commonsense.t	583 B	-r--r--r--	2014-12-27 11:49
compmod.pl	274 B	-r--r--r--	2014-12-27 11:49
croak.t	126 B	-r--r--r--	2014-12-27 11:49
cygwin.t	2.2 KB	-r--r--r--	2014-12-27 11:49
dbmt_common.pl	11.85 KB	-r--r--r--	2014-12-27 11:49
deprecate.t	2.11 KB	-r--r--r--	2014-12-27 11:49
h2ph.h	3.98 KB	-r--r--r--	2014-12-27 11:49
h2ph.pht	3.96 KB	-r--r--r--	2014-12-27 11:49
mypragma.pm	596 B	-r--r--r--	2014-12-27 11:49
mypragma.t	1.32 KB	-r--r--r--	2014-12-27 11:49
no_load.t	637 B	-r--r--r--	2014-12-27 11:49
overload_fallback.t	388 B	-r--r--r--	2014-12-27 11:49
overload_nomethod.t	362 B	-r--r--r--	2014-12-27 11:49
proxy_constant_subs.t	873 B	-r--r--r--	2014-12-27 11:49
test_require.pm	114 B	-r--r--r--	2014-12-27 11:49
test_use.pm	126 B	-r--r--r--	2014-12-27 11:49
test_use_14937.pm	3 B	-r--r--r--	2014-12-27 11:49
universal.t	1.89 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./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)";
----
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.
====
}

# 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';