use strict;
use warnings;
use 5.010;
+our ($REGMARK, $REGERROR);
sub run_tests;
## Should probably put in tests for all the POSIX stuff,
## but not sure how to guarantee a specific locale......
- skip "Not an ASCII platform", 2 unless $::IS_ASCII;
my $message = 'Test [[:cntrl:]]';
my $AllBytes = join "" => map {chr} 0 .. 255;
(my $x = $AllBytes) =~ s/[[:cntrl:]]//g;
+ $x = join "", sort { $a cmp $b }
+ map { chr utf8::native_to_unicode(ord $_) } split "", $x;
is($x, join("", map {chr} 0x20 .. 0x7E, 0x80 .. 0xFF), $message);
($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
+ $x = join "", sort { $a cmp $b }
+ map { chr utf8::native_to_unicode(ord $_) } split "", $x;
is($x, (join "", map {chr} 0x00 .. 0x1F, 0x7F), $message);
}
{
# Test named commits and the $REGERROR var
- our $REGERROR;
+ local $REGERROR;
for my $name ('', ':foo') {
for my $pat ("(*PRUNE$name)",
($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
# Test named commits and the $REGERROR var
package Fnorble;
our $REGERROR;
+ local $REGERROR;
for my $name ('', ':foo') {
for my $pat ("(*PRUNE$name)",
($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
{
# Test named commits and the $REGERROR var
my $message = '$REGERROR';
- our $REGERROR;
+ local $REGERROR;
for my $word (qw (bar baz bop)) {
$REGERROR = "";
"aaaaa$word" =~
{
my $message = '$REGMARK';
our @r = ();
- our ($REGMARK, $REGERROR);
+ local $REGMARK;
+ local $REGERROR;
like('foofoo', qr/foo (*MARK:foo) (?{push @r,$REGMARK}) /x, $message);
is("@r","foo", $message);
is($REGMARK, "foo", $message);
{
# Test for keys in %+ and %-
my $message = 'Test keys in %+ and %-';
- no warnings 'uninitialized', 'deprecated', 'experimental::lexical_topic';
- my $_ = "abcdef";
+ no warnings 'uninitialized';
+ local $_ = "abcdef";
/(?<foo>a)|(?<foo>b)/;
is((join ",", sort keys %+), "foo", $message);
is((join ",", sort keys %-), "foo", $message);
{
# length() on captures, the numbered ones end up in Perl_magic_len
- no warnings 'deprecated', 'experimental::lexical_topic';
- my $_ = "aoeu " . uni_to_native("\xe6") . "var ook";
+ local $_ = "aoeu " . uni_to_native("\xe6") . "var ook";
/^ \w+ \s (?<eek>\S+)/x;
is(length $`, 0, q[length $`]);
is "$1" || $@, "at", 'empty \N{...} stringified and retoked';
}
+ is (scalar split(/\b{sb}/, "Don't think twice. It's all right."),
+ 2, '\b{wb} splits sentences correctly');
+
+
+ # !!! NOTE! Keep the following tests last -- they may crash perl
- #
- # Keep the following tests last -- they may crash perl
- #
print "# Tests that follow may crash perl\n";
{
eval '/\k/';
sub Is_32_Bit_Super { return "110000\tFFFFFFFF\n" }
sub Is_Portable_Super { return '!utf8::Any' } # Matches beyond 32 bits
- SKIP:
{ # Assertion was failing on on 64-bit platforms; just didn't work on 32.
- skip("EBCDIC only goes to 31 bits", 4) if $::IS_EBCDIC;
no warnings qw(non_unicode portable);
+ no warnings 'deprecated'; # These are above IV_MAX
use Config;
# We use 'ok' instead of 'like' because the warnings are lexically
# scoped, and want to turn them off, so have to do the match in this
- # scope. (EBCDIC platforms can't handle above 2**32 - 1
+ # scope.
if ($Config{uvsize} < 8) {
ok(chr(0xFFFF_FFFE) =~ /\p{Is_32_Bit_Super}/,
"chr(0xFFFF_FFFE) can match a Unicode property");
# (during compilation, so use a fresh perl)
$Config{uvsize} == 8
or skip("need large code-points for this test", 1);
- fresh_perl_is('/\x{E000000000}|/ and print qq(ok\n)', "ok\n", {},
+
+ # This is above IV_MAX on 32 bit machines, so turn off those warnings
+ fresh_perl_is('no warnings "deprecated"; /\x{E000000000}|/ and print qq(ok\n)', "ok\n", {},
"buffer overflow in TRIE_STORE_REVCHAR");
}
-
# !!! NOTE that tests that aren't at all likely to crash perl should go
- # a ways above, above these last ones.
+ # a ways above, above these last ones. There's a comment there that, like
+ # this comment, contains the word 'NOTE'
done_testing();
} # End of sub run_tests