perl

 view release on metacpan or  search on metacpan

dist/Attribute-Handlers/lib/Attribute/Handlers.pm  view on Meta::CPAN

}

sub AUTOLOAD {
	return if $AUTOLOAD =~ /::DESTROY$/;
	my ($class) = $AUTOLOAD =~ m/(.*)::/g;
	$AUTOLOAD =~ m/_ATTR_(.*?)_(.*)/ or
	    croak "Can't locate class method '$AUTOLOAD' via package '$class'";
	croak "Attribute handler '$2' doesn't handle $1 attributes";
}

my $builtin = $] ge '5.027000'
    ? qr/lvalue|method|shared/
    : qr/lvalue|method|locked|shared|unique/;

sub _gen_handler_AH_() {
	return sub {
	    _resolve_lastattr if _delayed_name_resolution;
	    my ($pkg, $ref, @attrs) = @_;
	    my (undef, $filename, $linenum) = caller 2;
	    foreach (@attrs) {
		my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next;

dist/Carp/t/arg_regexp.t  view on Meta::CPAN

use Test::More tests => 42;

use Carp ();

sub lmm { Carp::longmess("x") }
sub lm { lmm() }
sub rx { qr/$_[0]/ }

# Use full generality on sufficiently recent versions.  On early Perl
# releases, U+E9 is 0x51 on all EBCDIC code pages supported then.
my $e9 = sprintf "%02x", (($] ge 5.007_003)
                          ? utf8::unicode_to_native(0xe9)
                          : ((ord("A") == 193)
                             ? 0x51
                             : 0xE9));
my $xe9 = "\\x$e9";
my $chr_e9 = eval "\"$xe9\"";
my $nl_as_hex = sprintf "%x", ord("\n");

# On Perl 5.6 we accept some incorrect quoting of Unicode characters,
# because upgradedness of regexps isn't preserved by stringification,

dist/Carp/t/arg_string.t  view on Meta::CPAN

use Test::More tests => 33;

use Carp ();

sub lmm { Carp::longmess("x") }
sub lm { lmm() }

# Use full generality on sufficiently recent versions.  On early Perl
# releases, U+E9 is 0x51 on all EBCDIC code pages supported then.
my $e9 = sprintf "%02x", (($] ge 5.007_003)
                          ? utf8::unicode_to_native(0xe9)
                          : ((ord("A") == 193)
                             ? 0x51
                             : 0xE9));
my $xe9 = "\\x$e9";
my $chr_e9 = eval "\"$xe9\"";
my $nl_as_hex = sprintf "%x", ord("\n");

like lm(3), qr/main::lm\(3\)/;
like lm(substr("3\x{2603}", 0, 1)), qr/main::lm\(3\)/;

dist/Devel-PPPort/t/testutil.pl  view on Meta::CPAN

$| = 1;
$Level = 1;
my $test = 1;
my $planned;
my $noplan;

# Fatalize warnings, so that we don't introduce new warnings.  But on early
# perls the burden of avoiding warnings becomes too large, and someone still
# trying to use such outmoded versions should be willing to accept warnings in
# our test suite.
$SIG{__WARN__} = sub { die "Fatalized: $_[0]" } if $] ge "5.6.0";

# This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
$::IS_ASCII  = ord 'A' ==  65;

$TODO = 0;
$NO_ENDING = 0;
$Tests_Are_Passing = 1;

# Use this instead of print to avoid interference while testing globals.
sub _print {

dist/Dumpvalue/lib/Dumpvalue.pm  view on Meta::CPAN

package Dumpvalue;
use strict;
use warnings;
our $VERSION = '1.21';
our(%address, $stab, @stab, %stab, %subs);

sub ASCII { return ord('A') == 65; }

# This module will give incorrect results for some inputs on EBCDIC platforms
# before v5.8
*to_native = ($] lt "5.008")
             ? sub { return shift }
             : sub { return utf8::unicode_to_native(shift) };

my $APC = chr to_native(0x9F);
my $backslash_c_question = (ASCII) ? '\177' : $APC;

# documentation nits, handle complex data structures better by chromatic
# translate control chars to ^X - Randal Schwartz
# Modifications to print types by Peter Gordon v1.0

dist/Search-Dict/Makefile.PL  view on Meta::CPAN

  "VERSION_FROM" => "lib/Search/Dict.pm",
  "ABSTRACT_FROM" => "lib/Search/Dict.pm",
  "AUTHOR" => "The Perl 5 Porters",
  "EXE_FILES" => [],
  "LICENSE" => "perl",
  "PREREQ_PM" => {
    "Exporter" => 0,
    "Test::More" => 0.47,
    "Tie::Handle" => 0,
  },
  INSTALLDIRS => ( $] lt '5.012' ? 'perl' : 'site' ),
);

WriteMakefile(%WriteMakefileArgs);

dist/Search-Dict/t/Dict.t  view on Meta::CPAN

#!./perl

use strict;
use Test::More;
plan tests => ( $] ge '5.008' ? 14 : 10 );

my $DICT = <<EOT;
Aarhus
Aaron
Ababa
aback
abaft
abandon
abandoned
abandoning

dist/Search-Dict/t/Dict.t  view on Meta::CPAN

  $word = <DICT>;
  chomp $word;

  cmp_ok $pos, ">=", 0, "case-insensitive search for 'aarhus' returned > 0";
  is $word, "Aarhus", "case-insensitive search found 'Aarhus'";

  untie *DICT;
}
unlink "dict-$$";

if ( $] ge '5.008' ) {
      open my $strfh, "<", \$DICT or die $!;

      {
          my $pos = look $strfh, 'Ababa';
          chomp($word = <$strfh>);
          cmp_ok $pos, ">=", 0;
          is $word, "Ababa";
      }

      {

dist/Storable/stacksize  view on Meta::CPAN

# instead so a user setting of either variable more closely matches
# the limits the use sees.

# be fairly aggressive in trimming this, smoke testing showed
# several apparently random failures here, eg. working in one
# configuration, but not in a very similar configuration.
$max_depth = int(0.6 * $max_depth);
$max_depth_hash = int(0.6 * $max_depth_hash);

my $stack_reserve = $^O eq "MSWin32" ? 32 : 16;
if ($] ge "5.016" && !($^O eq "cygwin" && $ptrsize == 8)) {
    $max_depth -= $stack_reserve;
    $max_depth_hash -= $stack_reserve;
}
else {
    # within the exception we need another stack depth to recursively
    # cleanup the hash
    $max_depth = ($max_depth >> 1) - $stack_reserve;
    $max_depth_hash = ($max_depth_hash >> 1) - $stack_reserve * 2;
}

dist/Storable/t/utf8.t  view on Meta::CPAN

my $x = chr(1234);
is($x, ${thaw freeze \$x}, "round trip one unicode character");

# Long scalar
$x = join '', map {chr $_} (0..1023);
is($x, ${thaw freeze \$x}, "round trip Unicode string");

# Char in the range 127-255 (probably) in utf8.  This just won't work for
# EBCDIC for early Perls.
$x = ($] lt 5.007_003) ? chr(175) : chr(utf8::unicode_to_native(175))
    . chr (256);
chop $x;
is($x, ${thaw freeze \$x}, "round strip a 128-255 character");

# Storable needs to cope if a frozen string happens to be internal utf8
# encoded

$x = chr 256;
my $data = freeze \$x;
is($x, ${thaw $data}, "sanity check for upgraded frozen data");

dist/Unicode-Normalize/mkheader  view on Meta::CPAN

use SelectSaver;

our $PACKAGE = 'Unicode::Normalize, mkheader';

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.  But in v5.35, pack U stopped
# trying to compensate
*pack_U = ($] ge 5.020 && $] lt 5.035)
          ? sub { return pack('U*', map { utf8::unicode_to_native($_) } @_); }
          : sub { return pack('U*', @_); };

# %Canon and %Compat will be ($codepoint => $hexstring) after _U_stringify()
our %Comp1st;	# $codepoint => $listname  : may be composed with a next char.
our %CompList;	# $listname,$2nd  => $codepoint : composite

##### The below part is common to mkheader and PP #####

our %Combin;	# $codepoint => $number    : combination class

pod/perldiag.pod  view on Meta::CPAN

 (?<![sS]t)
 (?<![fF]f[iI])

This fools Perl into not matching the ligatures.

Another option for Perls starting with 5.16, if you only care about
ASCII matches, is to add the C</aa> modifier to the regex.  This will
exclude all these non-obvious matches, thus getting rid of this message.
You can also say

 use if $] ge 5.016, re => '/aa';

to apply C</aa> to all regular expressions compiled within its scope.
See L<re>.

=item Variable length positive lookbehind with capturing is experimental in regex m/%s/

(W) Variable length positive lookbehind with capturing is not well defined. This
warning alerts you to the fact that you are using a construct which may
change in a future version of perl. See the
L<< documentation of Positive Lookbehind in perlre|perlre/"C<(?<=I<pattern>)>" >>