add tests to make sure the \s and [\s] match the same thing
Yves Orton [Sun, 4 Oct 2009 11:19:59 +0000 (13:19 +0200)]
Note: we currently fail these tests. This will be recitified.

MANIFEST
t/re/pat_special_cc.t [new file with mode: 0644]
t/re/pat_special_cc_thr.t [new file with mode: 0644]

index 83cd2f1..9eaaf67 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4442,6 +4442,8 @@ t/re/pat_re_eval.t                See if esoteric patterns using re 'eval' work
 t/re/pat_re_eval_thr.t         See if esoteric patterns using re 'eval' work in another thread
 t/re/pat_rt_report.t           See if esoteric patterns from rt reports work
 t/re/pat_rt_report_thr.t       See if esoteric patterns from rt reports work in another thread
+t/re/pat_special_cc.t          See if special charclasses (\s \w \d) work the same as (\s and [\s])
+t/re/pat_special_cc_thr.t      See if special charclasses (\s \w \d) work the same as (\s and [\s]) under threads
 t/re/pat.t                     See if esoteric patterns work
 t/re/pat_thr.t                 See if esoteric patterns work in another thread
 t/re/qr_gc.t                   See if qr doesn't leak
diff --git a/t/re/pat_special_cc.t b/t/re/pat_special_cc.t
new file mode 100644 (file)
index 0000000..1138cbb
--- /dev/null
@@ -0,0 +1,56 @@
+#!./perl
+#
+# This test file is used to bulk check that /\s/ and /[\s]/ 
+# test the same and that /\s/ and /\S/ are opposites, and that
+# /[\s]/ and /[\S]/ are also opposites, for \s/\S and \d/\D and 
+# \w/\W.
+use strict;
+use warnings;
+use 5.010;
+
+
+sub run_tests;
+
+$| = 1;
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib','.');
+    do "re/ReTest.pl" or die $@;
+}
+
+
+plan tests => 9;  # Update this when adding/deleting tests.
+
+run_tests() unless caller;
+
+#
+# Tests start here.
+#
+sub run_tests {
+    my $upper_bound= 10_000;
+    for my $special (qw(\s \w \d)) {
+        my $upper= uc($special);
+        my @cc_plain_failed;
+        my @cc_complement_failed;
+        my @plain_complement_failed;
+        for my $ord (0 .. $upper_bound) {
+            my $ch= chr $ord;
+            my $plain= $ch=~/$special/ ? 1 : 0;
+            my $plain_u= $ch=~/$upper/ ? 1 : 0;
+            push @plain_complement_failed, "$ord-$plain-$plain_u" if $plain == $plain_u;
+
+            my $cc= $ch=~/[$special]/ ? 1 : 0;
+            my $cc_u= $ch=~/[$upper]/ ? 1 : 0;
+            push @cc_complement_failed, "$ord-$cc-$cc_u" if $cc == $cc_u;
+
+            push @cc_plain_failed, "$ord-$plain-$cc" if $plain != $cc;
+        }
+        iseq(join(" | ",@cc_plain_failed),"", "Check that /$special/ and /[$special]/ match same things (ord-plain-cc)");
+        iseq(join(" | ",@plain_complement_failed),"", "Check that /$special/ and /$upper/ are complements (ord-plain-plain_u)");
+        iseq(join(" | ",@cc_complement_failed),"", "Check that /[$special]/ and /[$upper]/ are complements (ord-cc-cc_u)");
+    }
+} # End of sub run_tests
+
+1;
diff --git a/t/re/pat_special_cc_thr.t b/t/re/pat_special_cc_thr.t
new file mode 100644 (file)
index 0000000..f06e225
--- /dev/null
@@ -0,0 +1,7 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = ('../lib', '.');
+
+require 'thread_it.pl';
+thread_it(qw(re pat_special_cc.t));