t/re/regex_sets.t: Add some tests

[perl5.git] / t / re / regex_sets.t

diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index c85fde6..cd5df00 100644 (file)
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -27,7 +27,6 @@ like("a", qr/(?[ [a]      # This is a comment
 like("a", qr/(?[ [a]      # [[:notaclass:]]
                     ])/, 'A comment isn\'t parsed');
 unlike(uni_to_native("\x85"), qr/(?[ \t\85 ])/, 'NEL is white space');
-unlike(uni_to_native("\x85"), qr/(?[ [\t\85] ])/, '... including within nested []');
 like(uni_to_native("\x85"), qr/(?[ \t + \\85 ])/, 'can escape NEL to match');
 like(uni_to_native("\x85"), qr/(?[ [\\85] ])/, '... including within nested []');
 like("\t", qr/(?[ \t + \\85 ])/, 'can do basic union');
@@ -97,6 +96,10 @@ like("k", $still_fold, "/i on interpolated (?[ ]) is retained in outer without /
 eval 'my $x = qr/(?[ [a] ])/; qr/(?[ $x ])/';
 is($@, "", 'qr/(?[ [a] ])/ can be interpolated');
 
+like("B", qr/(?[ [B] | ! ( [^B] ) ])/, "[perl #125892]");
+
+like("a", qr/(?[ (?#comment) [a]])/, "Can have (?#comments)");
+
 if (! is_miniperl() && locales_enabled('LC_CTYPE')) {
     my $utf8_locale = find_utf8_ctype_locale;
     SKIP: {
@@ -123,6 +126,8 @@ if (! is_miniperl() && locales_enabled('LC_CTYPE')) {
 
         # These should generate warnings (the above 4 shouldn't), but like()
         # suppresses them, so the warnings tests are in t/lib/warnings/regexec
+        $^W = 0;   # Suppress the warnings that occur when run by hand with
+                   # the -w option
         like("\N{KELVIN SIGN}", $kelvin_fold,
              '(?[ \N{KELVIN SIGN} ]) matches itself under /i in C locale');
         like("K", $kelvin_fold,
@@ -134,6 +139,48 @@ if (! is_miniperl() && locales_enabled('LC_CTYPE')) {
     }
 }
 
+# Tests that no warnings given for valid Unicode digit range.
+my $arabic_digits = qr/(?[ [ ٠ - ٩ ] ])/;
+for my $char ("٠", "٥", "٩") {
+    use charnames ();
+    my @got = capture_warnings(sub {
+                like("٠", $arabic_digits, "Matches "
+                                                . charnames::viacode(ord $char));
+            });
+    is (@got, 0, "... without warnings");
+}
+
+# RT #126181: \cX behaves strangely inside (?[])
+{
+       no warnings qw(syntax regexp);
+
+       eval { $_ = '/(?[(\c]) /'; qr/$_/ };
+       like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic');
+       eval { $_ = '(?[\c#]' . "\n])"; qr/$_/ };
+       like($@, qr/^Syntax error/, '/(?[(\c]) / should not panic');
+       eval { $_ = '(?[(\c])'; qr/$_/ };
+       like($@, qr/^Syntax error/, '/(?[(\c])/ should be a syntax error');
+       eval { $_ = '(?[(\c]) ]\b'; qr/$_/ };
+       like($@, qr/^Syntax error/, '/(?[(\c]) ]\b/ should be a syntax error');
+       eval { $_ = '(?[\c[]](])'; qr/$_/ };
+       like($@, qr/^Syntax error/, '/(?[\c[]](])/ should be a syntax error');
+       like("\c#", qr/(?[\c#])/, '\c# should match itself');
+       like("\c[", qr/(?[\c[])/, '\c[ should match itself');
+       like("\c\ ", qr/(?[\c\])/, '\c\ should match itself');
+       like("\c]", qr/(?[\c]])/, '\c] should match itself');
+}
+
+# RT #126481 !! with syntax error panics
+{
+    fresh_perl_like('no warnings "experimental::regex_sets"; qr/(?[ ! ! (\w])/',
+                    qr/^Unmatched \(/, {},
+                    'qr/(?[ ! ! (\w])/ doesnt panic');
+    # The following didn't panic before, but easy to add this here with a
+    # paren between the !!
+    fresh_perl_like('no warnings "experimental::regex_sets";qr/(?[ ! ( ! (\w)])/',
+                    qr/^Unmatched \(/, {},
+                    'qr/qr/(?[ ! ( ! (\w)])/');
+}
 
 done_testing();