view release on metacpan or search on metacpan
lib/Text/Sprintf/Zenkaku.pm view on Meta::CPAN
our @EXPORT_OK = qw(sprintf);
our $cp932 = Encode::find_encoding("cp932");
our $conversions = qr/\A[cduoxefgXEGbBpnaA]\Z/;
$conversions = qr/\A[cduoxefgXEGbBpn]\Z/ if $] lt 5.022000;
$conversions = qr/\A[cduoxefgXEGbpn]\Z/ if $] lt 5.010000;
sub calc_width {
my ($w, $s) = @_;
my $ofs;
view all matches for this distribution
view release on metacpan or search on metacpan
t/00_smoke.t view on Meta::CPAN
use Test::More tests=>2; # remember to keep in sync with done_testing
BEGIN {
diag "This is Perl $] at $^X on $^O";
BAIL_OUT("Perl 5.8.1 is required") if $] lt '5.008001';
}
use FindBin ();
use lib $FindBin::Bin;
use Tie_Handle_Base_Testlib;
view all matches for this distribution
view release on metacpan or search on metacpan
t/00-basics.t view on Meta::CPAN
$notvivi{foo} = 'default0';
$notvivi{bar} = "my data";
$notvivi{baz} = "default1";
SKIP: {
skip "scalar() mysteriously broken on Ye Olde Perle", 1,
unless($] gt 5.008002);
is(scalar(%{$vivi}), scalar(%notvivi), "scalar() works, as if anyone's likely to ever bother");
}
%{$vivi} = ();
is_deeply([keys %{$vivi}], [], "can clear the hash");
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Tie/Subset/Hash.pm view on Meta::CPAN
sub SCALAR {
my ($self) = @_;
# I'm not sure why the following counts as two statements in the coverage tool
# uncoverable branch true
# uncoverable statement count:2
return scalar %{$self->{keys}} if $] lt '5.026';
my %keys = map {$_=>1} grep {exists $self->{hash}{$_}} keys %{$self->{keys}};
return scalar keys %keys;
}
sub UNTIE {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Type/Tiny/XS.pm view on Meta::CPAN
Map Tuple Enum AnyOf AllOf
/
);
$names{Item} = $names{Any};
if ( $] lt '5.010000' ) {
require MRO::Compat;
*Type::Tiny::XS::Util::get_linear_isa = \&mro::get_linear_isa;
my $overloaded = sub {
require overload;
lib/Type/Tiny/XS.pm view on Meta::CPAN
if ( $type =~ /^ArrayRef\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_ArrayRef_for( $child );
}
elsif ( $] ge '5.010000' and $type =~ /^ArrayLike\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_ArrayLike_for( $child );
}
elsif ( $type =~ /^HashRef\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_HashRef_for( $child );
}
elsif ( $] ge '5.010000' and $type =~ /^HashLike\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_HashLike_for( $child );
}
elsif ( $type =~ /^Map\[(.+),(.+)\]$/ ) {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Eval/TypeTiny.pm view on Meta::CPAN
#<<<
# uncoverable subroutine
sub ALIAS_IMPLEMENTATION () {
$implementation ||= _pick_alternative(
if => ( $] ge '5.022' ) => IMPLEMENTATION_NATIVE,
needs => 'Devel::LexAlias' => IMPLEMENTATION_DEVEL_LEXALIAS,
needs => 'PadWalker' => IMPLEMENTATION_PADWALKER,
if => !!1 => IMPLEMENTATION_TIE,
);
}
view all matches for this distribution
view release on metacpan or search on metacpan
our $prefix = "UNF_";
our $structname = "${prefix}complist";
# Starting in v5.20, the tables in lib/unicore are built using the platform's
# native character set for code points 0-255.
*pack_U = ($] ge 5.020)
? sub { return pack('W*', @_).pack('U*'); } # The empty pack returns
# an empty UTF-8 string,
# so the effect is to
# force the return into
# being UTF-8.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Util/H2O.pm view on Meta::CPAN
BEGIN {
# lock_ref_keys wasn't available until Hash::Util 0.06 / Perl v5.8.9
# (note the following will probably also fail on the Perl v5.9 dev releases)
# uncoverable branch false
# uncoverable condition false
if ( $] ge '5.008009' ) {
require Hash::Util;
Hash::Util->import(qw/ lock_ref_keys lock_hashref /) }
else {
*lock_ref_keys = *lock_hashref = sub {
carp "this Perl is too old to lock the hash"; # uncoverable statement
view all matches for this distribution
view release on metacpan or search on metacpan
SKIP: {
# TODO: spot why this does NOT dies correctly in 5.10
# even if the test of the module dies..
skip if $] lt '5.014';
# job dies with an incorrect crontab
dies_ok { $bkp->job(cron=>'one 0 0 25',src=>'x:\\',name=>'test') } 'job method expected to die with an invalid crontab';
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Win32/CommandLine.pm view on Meta::CPAN
my @g_star = $should_glob ? File::Globstar::globstar( $p, $glob_flags ) : ($base);
# File::Globstar doesn't maintain bsd_glob sorting; sort here
# * use case folding over case conversion, when available; (Unicode::CaseFold::fc() or Unicode::Collate->sort() are alternatives)
# * ref: https://www.perlmonks.org/?node_id=1228944 @@ https://archive.is/4tqfK , https://www.webcitation.org/75hjb1t3m , https://goo.gl/JUQsL3
# * ref: http://www.howtobuildsoftware.com/index.php/how-do/cht/perl-version-dependent-fallback-code @@ https://archive.is/HdQt4 , https://goo.gl/gv5Kik
if ( $] ge '5.016' ) {
## no critic ( ProhibitAmpersandSigils )
@g_star = sort { ( &CORE::fc($a) ) cmp ( &CORE::fc($b) ) } @g_star;
}
else { @g_star = sort { ( lc $a ) cmp ( lc $b ) } @g_star; }
## ToDO: consider POSIX compatible collation (base on LC_COLLATE) ... `@g_star = sort { POSIX::strcoll($a, $b) } @g_star;`
view all matches for this distribution
view release on metacpan or search on metacpan
sub DESTROY { }
if (defined &DynaLoader::boot_DynaLoader) {
#next 2 lines are special matched in Makefile.PL, update that if changed
delete local $DynaLoader::{'VERSION'} if $] lt '5.009005';
delete local $DynaLoader::{'XS_VERSION'} if $] lt '5.009005';
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION);
tie %Config, 'Config';
} else {
no warnings 'redefine';
view all matches for this distribution
view release on metacpan or search on metacpan
use IO::Handle ();
use Module::Runtime qw( use_module );
use Zydeco::Lite qw( true false );
BEGIN {
*PERL_IS_MODERN = ( $] ge '5.014' ) ? \&true : \&false;
}
my $STRICT = 0;
$ENV{$_} && ++$STRICT && last for qw(
EXTENDED_TESTING
my @modules =
grep { my $name = $_->[0]; $name !~ /feature|Try/ } $class->modules;
push @modules, [ 'Try::Tiny', '0.30' ];
if ( $] ge '5.010' ) {
push @modules, [ 'feature', '0', qw( say ) ];
}
else {
push @modules, [ 'Perl6::Say', '0.06' ];
push @modules, [ 'UNIVERSAL::DOES', '0.001' ];
view all matches for this distribution
view release on metacpan or search on metacpan
local/lib/perl5/Eval/TypeTiny.pm view on Meta::CPAN
#<<<
# uncoverable subroutine
sub ALIAS_IMPLEMENTATION () {
$implementation ||= _pick_alternative(
if => ( $] ge '5.022' ) => IMPLEMENTATION_NATIVE,
needs => 'Devel::LexAlias' => IMPLEMENTATION_DEVEL_LEXALIAS,
needs => 'PadWalker' => IMPLEMENTATION_PADWALKER,
if => !!1 => IMPLEMENTATION_TIE,
);
}
view all matches for this distribution
view release on metacpan or search on metacpan
t/50complextypes.t view on Meta::CPAN
use warnings;
use Test::More;
use Test::Fatal;
BEGIN {
if ($] lt '5.016') {
plan(skip_all => 'known limitation in Perl 5.14');
exit();
}
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/builtins/compat.pm view on Meta::CPAN
!!0;
}
BEGIN {
# uncoverable statement
*LEGACY_PERL = ( $] lt '5.036' ) ? \&_true : \&_false;
};
our %EXPORT_TAGS = (
'5.36' => [ qw<
true false is_bool
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Inline/CPP.pm view on Meta::CPAN
my ($o, $value) = @_;
$value =~ s/^::|::$//g;
# Perl 5.12 indroduced \p{XID_Start} and \p{XID_Continue}. Prior to that
# we should downgrade gracefully.
my $ident = $] ge '5.0120'
? qr{[\p{XID_Start}_][\p{XID_Continue}_]*}
: qr{[\p{Alpha}_][\p{Alpha}\p{Digit}_]*};
croak "$value is an invalid package name."
unless length $value == 0
view all matches for this distribution
view release on metacpan or search on metacpan
eval { require Mouse::Util; } unless HAS_XS();
*HAS_MOUSE = eval { Mouse::Util::MOUSE_XS() and 'Mouse::Util'->can('generate_isa_predicate_for') }
? sub(){!!1}
: sub(){!!0};
*HAS_NATIVE = ( $] ge '5.032' )
? sub(){!!1}
: sub(){!!0};
*perlstring = eval { require B; 'B'->can('perlstring') }
|| sub { sprintf '"%s"', quotemeta($_[0]) };
view all matches for this distribution
view release on metacpan or search on metacpan
t/01_basic.t view on Meta::CPAN
use VMod;
is(version->parse($VMod::VERSION), version->parse(1.0), 'version ok');
my $dfh = *{VMod::DATA};
ok(fileno($dfh), 'handle ok');
ok($dfh->can('seek'), 'can seek') if $] ge '5.020';
ok(seek($dfh, 0, 0), 'seek successful');
local $/ = undef;
my $data = <$dfh>;
$data =~ s/^.*\n__DATA__\r?\n/\n/s;
view all matches for this distribution
view release on metacpan or search on metacpan
t/additional_tests/spar_unix.test view on Meta::CPAN
# which it was originally conceived.)
# FreeBSD 4.10 and Darwin 5.5 allow truncating a write protected file :-(
die if open my $fh, '>', 'd.spar';
$] ge '5.01' and
# Can we chmod on this fs?
((stat 'd.spar')[2] & 0777) == 0444 and
chmod 0650, 'd.spar' and
# chmod fails with success on Samba.
((stat 'd.spar')[2] & 0777) == 0650;
view all matches for this distribution
view release on metacpan or search on metacpan
t/02simple.t view on Meta::CPAN
does_match(1, $obj2);
doesnt_match(0, $obj2);
# If the right hand side is an object which overloads "~~", then a
# true smart match is performed.
if ( $] le '5.036000' ) {
my $obj3 = eval q{
no warnings;
no strict 'refs';
package Local::YetAnotherClass;
use overload q[~~] => sub { $_[1] }, fallback => 1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/match/simple.pm view on Meta::CPAN
if ( my $match = $obj->can( 'MATCH' ) ) {
return $match;
}
if ( $] lt '5.010' ) { require MRO::Compat; }
else { require mro; }
my @mro = @{ mro::get_linear_isa( ref $obj ) };
for my $class ( @mro ) {
my $name = "$class\::(~~";
view all matches for this distribution
view release on metacpan or search on metacpan
t/parent-pmc.t view on Meta::CPAN
plan skip_all => ".pmc are only available with 5.6 and later" if $] < 5.006;
# Skip this test if perl is compiled with PERL_DISABLE_PMC
#
my $pmc = 1;
if (Config->can('non_bincompat_options')) { # $] ge '5.014'
$pmc = 0
if grep { $_ eq 'PERL_DISABLE_PMC' } Config::non_bincompat_options();
} elsif (eval {
require Config::Perl::V;
Config::Perl::V->VERSION('0.10');
view all matches for this distribution
view release on metacpan or search on metacpan
cpan/CPAN-Meta/lib/CPAN/Meta.pm view on Meta::CPAN
sub save {
my ($self, $file, $options) = @_;
my $version = $options->{version} || '2';
my $layer = $] ge '5.008001' ? ':utf8' : '';
if ( $version ge '2' ) {
carp "'$file' should end in '.json'"
unless $file =~ m{\.json$};
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/results/wrap.pm view on Meta::CPAN
our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION = '0.006';
BEGIN {
if ( $] ge '5.034' ) {
require experimental;
'experimental'->import( 'try' );
}
else {
require Syntax::Keyword::Try;
view all matches for this distribution
view release on metacpan or search on metacpan
t/coretests.pm view on Meta::CPAN
ok("$version" eq "v1.2.3", 'v-string initialized $qv_declare()');
}
SKIP: {
skip 'Cannot test bare alpha v-strings with Perl < 5.8.1', 2
if $] lt 5.008_001;
$version = $CLASS->$method(v1.2.3_4);
$DB::single = 1;
is($version, "v1.2.34", '"$version" eq "v1.2.34"');
$version = $CLASS->$method(eval "v1.2.3_4");
is($version, "v1.2.34", '"$version" eq "v1.2.34" (from eval)');
view all matches for this distribution