Re: [PATCH] Add hook for re_dup() into regex engine as reg_dupe (make re pluggable under threads)

Message-ID: <9b18b3110609290341p11767110sec20a6fee2038a00@mail.gmail.com>

p4raw-id: //depot/perl@28900

3 files changed, 58 insertions, 4 deletions

diff --git a/ext/re/t/lexical_debug.pl b/ext/re/t/lexical_debug.pl
new file mode 100644
index 0000000000..c8b7c5bc67
--- /dev/null
+++ b/ext/re/t/lexical_debug.pl
@@ -0,0 +1,25 @@
+use re 'debug';
+
+$_ = 'foo bar baz bop fip fop';
+
+/foo/ and $count++;
+
+{
+    no re 'debug';
+    /bar/ and $count++;
+    {
+        use re 'debug';
+        /baz/ and $count++;
+    }
+    /bop/ and $count++;
+}
+
+/fip/ and $count++;
+
+no re 'debug';
+
+/fop/ and $count++;
+
+print "Count=$count\n";
+
+
diff --git a/ext/re/t/lexical_debug.t b/ext/re/t/lexical_debug.t
new file mode 100644
index 0000000000..affa7c50fc
--- /dev/null
+++ b/ext/re/t/lexical_debug.t
@@ -0,0 +1,30 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config;
+    if (($Config::Config{'extensions'} !~ /\bre\b/) ){
+	print "1..0 # Skip -- Perl configured without re module\n";
+	exit 0;
+    }
+}
+
+use strict;
+require "./test.pl";
+my $out = runperl(progfile => "../ext/re/t/lexical_debug.pl", stderr => 1 );
+
+print "1..7\n";
+
+# Each pattern will produce an EXACT node with a specific string in 
+# it, so we will look for that. We can't just look for the string
+# alone as the string being matched against contains all of them.
+
+ok( $out =~ /EXACT <foo>/, "Expect 'foo'");
+ok( $out !~ /EXACT <bar>/, "No 'bar'");
+ok( $out =~ /EXACT <baz>/, "Expect 'baz'");
+ok( $out !~ /EXACT <bop>/, "No 'bop'");
+ok( $out =~ /EXACT <fip>/, "Expect 'fip'");
+ok( $out !~ /EXACT <fop>/, "No 'baz'");
+ok( $out =~ /Count=6\n/,"Count is 6");
+
diff --git a/ext/re/t/re.t b/ext/re/t/re.t
index 5f09966d81..204092f028 100644
--- a/ext/re/t/re.t
+++ b/ext/re/t/re.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 14;
+use Test::More tests => 13;
 require_ok( 're' );
 
 # setcolor
@@ -31,8 +31,8 @@ my $warn;
 local $SIG{__WARN__} = sub {
 	$warn = shift;
 };
-eval { re::bits(1) };
-like( $warn, qr/Useless use/, 'bits() should warn with no args' );
+#eval { re::bits(1) };
+#like( $warn, qr/Useless use/, 'bits() should warn with no args' );
 
 delete $ENV{PERL_RE_COLORS};
 re::bits(0, 'debug');
@@ -65,7 +65,6 @@ my $ok='foo'=~/$reg/;
 eval"no re Debug=>'ALL'";
 ok( $ok, 'No segv!' );
 
-
 package Term::Cap;
 
 sub Tgetent {