This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
allow fields in re_tests to include \x{nnn} etc
authorDave Mitchell <davem@fdisolutions.com>
Sun, 24 Sep 2006 21:23:28 +0000 (21:23 +0000)
committerDave Mitchell <davem@fdisolutions.com>
Sun, 24 Sep 2006 21:23:28 +0000 (21:23 +0000)
p4raw-id: //depot/perl@28882

t/op/re_tests
t/op/regexp.t

index 3514144..2dedaef 100644 (file)
@@ -80,7 +80,7 @@ a[b-d]e       ace     y       $&      ace
 a[b-d] aac     y       $&      ac
 a[-b]  a-      y       $&      a-
 a[b-]  a-      y       $&      a-
-a[b-a] -       c       -       Invalid [] range "b-a"
+a[b-a] -       c       -       Invalid [] range \"b-a\"
 a[]b   -       c       -       Unmatched [
 a[     -       c       -       Unmatched [
 a]     a]      y       $&      a]
@@ -144,7 +144,7 @@ a\  -       c       -       Search pattern not terminated
 a\(b   a(b     y       $&-$1   a(b-
 a\(*b  ab      y       $&      ab
 a\(*b  a((b    y       $&      a((b
-a\\b   a\b     y       $&      a\b
+a\\b   a\\b    y       $&      a\\b
 abc)   -       c       -       Unmatched )
 (abc   -       c       -       Unmatched (
 ((a))  abc     y       $&-$1-$2        a-a-a
@@ -245,8 +245,8 @@ multiple words      multiple words, yeah    y       $&      multiple words
 (.*)c(.*)      abcde   y       $&-$1-$2        abcde-ab-de
 \((.*), (.*)\) (a, b)  y       ($2, $1)        (b, a)
 [k]    ab      n       -       -
-abcd   abcd    y       $&-\$&-\\$&     abcd-$&-\abcd
-a(bc)d abcd    y       $1-\$1-\\$1     bc-$1-\bc
+abcd   abcd    y       $&-\$&-\\$&     abcd-\$&-\\abcd
+a(bc)d abcd    y       $1-\$1-\\$1     bc-\$1-\\bc
 a[-]?c ac      y       $&      ac
 (abc)\1        abcabc  y       $1      abc
 ([a-c]*)\1     abcabc  y       $1      abc
@@ -310,7 +310,7 @@ a[-]?c      ac      y       $&      ac
 'a[b-d]'i      AAC     y       $&      AC
 'a[-b]'i       A-      y       $&      A-
 'a[b-]'i       A-      y       $&      A-
-'a[b-a]'i      -       c       -       Invalid [] range "b-a"
+'a[b-a]'i      -       c       -       Invalid [] range \"b-a\"
 'a[]b'i        -       c       -       Unmatched [
 'a['i  -       c       -       Unmatched [
 'a]'i  A]      y       $&      A]
@@ -331,7 +331,7 @@ a[-]?c      ac      y       $&      ac
 'a\(b'i        A(B     y       $&-$1   A(B-
 'a\(*b'i       AB      y       $&      AB
 'a\(*b'i       A((B    y       $&      A((B
-'a\\b'i        A\B     y       $&      A\B
+'a\\b'i        A\\B    y       $&      A\\B
 'abc)'i        -       c       -       Unmatched )
 '(abc'i        -       c       -       Unmatched (
 '((a))'i       ABC     y       $&-$1-$2        A-A-A
@@ -393,8 +393,8 @@ a[-]?c      ac      y       $&      ac
 '(.*)c(.*)'i   ABCDE   y       $&-$1-$2        ABCDE-AB-DE
 '\((.*), (.*)\)'i      (A, B)  y       ($2, $1)        (B, A)
 '[k]'i AB      n       -       -
-'abcd'i        ABCD    y       $&-\$&-\\$&     ABCD-$&-\ABCD
-'a(bc)d'i      ABCD    y       $1-\$1-\\$1     BC-$1-\BC
+'abcd'i        ABCD    y       $&-\$&-\\$&     ABCD-\$&-\\ABCD
+'a(bc)d'i      ABCD    y       $1-\$1-\\$1     BC-\$1-\\BC
 'a[-]?c'i      AC      y       $&      AC
 '(abc)\1'i     ABCABC  y       $1      ABC
 '([a-c]*)\1'i  ABCABC  y       $1      ABC
index 678a46a..2b21766 100755 (executable)
@@ -30,6 +30,9 @@
 #
 # If you want to add a regular expression test that can't be expressed
 # in this format, don't add it here: put it in op/pat.t instead.
+#
+# Note that columns 2,3 and 5 are all enclosed in double quotes and then
+# evalled; so something like a\"\x{100}$1 has length 3+length($1).
 
 BEGIN {
     chdir 't' if -d 't';
@@ -64,10 +67,8 @@ while (<TESTS>) {
     $pat = "'$pat'" unless $pat =~ /^[:']/;
     $pat =~ s/(\$\{\w+\})/$1/eeg;
     $pat =~ s/\\n/\n/g;
-    $subject =~ s/(\$\{\w+\})/$1/eeg;
-    $subject =~ s/\\n/\n/g;
-    $expect =~ s/(\$\{\w+\})/$1/eeg;
-    $expect =~ s/\\n/\n/g;
+    $subject = eval qq("$subject");
+    $expect  = eval qq("$expect");
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
     $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     $reason = 'skipping $&' if $reason eq  '' && $skip_amp;