Add support for /k modfier for matching along with ${^PREMATCH}, ${^MATCH}, ${^POSTMATCH}

Message-ID: <9b18b3110701111731x29b1c63i57b1698f769b3bbc@mail.gmail.com>
(with tweaks)

p4raw-id: //depot/perl@29831

2 files changed, 48 insertions, 1 deletions

diff --git a/t/op/regexp.t b/t/op/regexp.t
index cce19fc03d..a7cd5fc7b9 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -125,7 +125,15 @@ EOFCODE
 	}
 	else {
 	    if (!$match || $got ne $expect) {
- 		print "not ok $. ($study) $input => `$got', match=$match\n$code\n";
+	        eval { require Data::Dumper };
+		if ($@) {
+		    print "not ok $. ($study) $input => `$got', match=$match\n$code\n";
+		}
+		else { # better diagnostics
+		    my $s = Data::Dumper->new([$subject],['subject'])->Useqq(1)->Dump;
+		    my $g = Data::Dumper->new([$got],['got'])->Useqq(1)->Dump;
+		    print "not ok $. ($study) $input => `$got', match=$match\n$s\n$g\n$code\n";
+		}
 		next TEST;
 	    }
 	}
diff --git a/t/op/regexp_kmod.t b/t/op/regexp_kmod.t
new file mode 100644
index 0000000000..84efd83546
--- /dev/null
+++ b/t/op/regexp_kmod.t
@@ -0,0 +1,39 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use strict;
+use warnings;
+
+our @tests = (
+    # /k     Pattern   PRE     MATCH   POST
+    [ 'k',   "456",    "123-", "456",  "-789"],
+    [ '',    "(456)",  "123-", "456",  "-789"],
+    [ '',    "456",    undef,  undef,  undef ],
+);
+
+plan tests => 4 * @tests + 2;
+my $W = "";
+
+$SIG{__WARN__} = sub { $W.=join("",@_); };
+sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }
+
+$_ = '123-456-789';
+foreach my $test (@tests) {
+    my ($k, $pat,$l,$m,$r) = @$test;
+    my $test_name = "/$pat/$k";
+    my $ok = ok($k ? /$pat/k : /$pat/, $test_name);
+    SKIP: {
+        skip "/$pat/$k failed to match", 3
+            unless $ok;
+        is(${^PREMATCH},  $l,_u "$test_name: ^PREMATCH",$l);
+        is(${^MATCH},     $m,_u "$test_name: ^MATCH",$m );
+        is(${^POSTMATCH}, $r,_u "$test_name: ^POSTMATCH",$r );
+    }
+}
+is($W,"","No warnings should be produced");
+ok(!defined ${^MATCH}, "No /k in scope so ^MATCH is undef");