This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Typos, POD errors, etc.
[perl5.git] / t / re / pat_advanced.t
index 629f2b2..1488a88 100644 (file)
@@ -15,6 +15,7 @@ BEGIN {
 use strict;
 use warnings;
 use 5.010;
+our ($REGMARK, $REGERROR);
 
 sub run_tests;
 
@@ -214,13 +215,16 @@ 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);
     }
 
@@ -1286,7 +1290,7 @@ sub run_tests {
 
     {
         # 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)",
@@ -1305,6 +1309,7 @@ sub run_tests {
         # 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)",
@@ -1322,7 +1327,7 @@ sub run_tests {
     {
         # Test named commits and the $REGERROR var
        my $message = '$REGERROR';
-        our $REGERROR;
+        local $REGERROR;
         for my $word (qw (bar baz bop)) {
             $REGERROR = "";
             "aaaaa$word" =~
@@ -1392,7 +1397,8 @@ sub run_tests {
     {
         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);
@@ -1680,7 +1686,6 @@ sub run_tests {
 
     {
         # length() on captures, the numbered ones end up in Perl_magic_len
-        no warnings 'deprecated', 'experimental::lexical_topic';
         local $_ = "aoeu " . uni_to_native("\xe6") . "var ook";
         /^ \w+ \s (?<eek>\S+)/x;
 
@@ -2314,10 +2319,12 @@ EOF
         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/';
@@ -2365,15 +2372,14 @@ EOF
     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");
@@ -2445,13 +2451,15 @@ EOF
         # (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