This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make 'no re' work
authorKarl Williamson <khw@cpan.org>
Wed, 4 Feb 2015 17:31:15 +0000 (10:31 -0700)
committerKarl Williamson <khw@cpan.org>
Wed, 4 Feb 2015 19:22:08 +0000 (12:22 -0700)
A plain 'no re'; without subpragmas prior to this commit only turned off
a few things.  Now it turns off all the enabled things.  For example,
previously, you couldn't turn off debugging, once enabled, inside the
same block.

ext/re/re.pm
ext/re/t/lexical_debug.pl
ext/re/t/lexical_debug.t
ext/re/t/reflags.t
ext/re/t/strict.t

index 30a0909..fa1c6e6 100644 (file)
@@ -111,7 +111,17 @@ sub _load_unload {
 sub bits {
     my $on = shift;
     my $bits = 0;
+    my $turning_all_off = ! @_ && ! $on;
     my %seen;   # Has flag already been seen?
+    if ($turning_all_off) {
+
+        # Pretend were called with certain parameters, which are best dealt
+        # with XXX
+        push @_, keys %bitmask; # taint and eval
+        push @_, 'strict';
+    }
+
+    # Process each subpragma parameter
    ARG:
     foreach my $idx (0..$#_){
         my $s=$_[$idx];
@@ -156,7 +166,7 @@ sub bits {
                 }
             }
             else {
-                $^H{reflags} &= ~$reflags{$s};
+                $^H{reflags} &= ~$reflags{$s} if $^H{reflags};
 
                 # Turn off warnings if we turned them on.
                 warnings->unimport('regexp') if $^H{re_strict};
@@ -249,6 +259,14 @@ sub bits {
             warnings::warn("regexp", $message);
         }
     }
+
+    if ($turning_all_off) {
+        _load_unload(0);
+        $^H{reflags} = 0;
+        $^H{reflags_charset} = 0;
+        $^H &= ~$flags_hint;
+    }
+
     $bits;
 }
 
index 3ec7455..0e74bf0 100644 (file)
@@ -1,6 +1,6 @@
 use re 'debug';
 
-$_ = 'foo bar baz bop fip fop';
+$_ = 'foo bar baz bop boq bor fip fop';
 
 /foo/ and $count++;
 
@@ -14,6 +14,13 @@ $_ = 'foo bar baz bop fip fop';
     /bop/ and $count++;
 }
 
+{
+    use re 'debug';
+    /boq/ and $count++;
+    no re;
+    /bor/ and $count++;
+}
+
 /fip/ and $count++;
 
 no re 'debug';
index d4b7e62..b2570f0 100644 (file)
@@ -15,7 +15,7 @@ use strict;
 BEGIN { require "../../t/test.pl"; }
 my $out = runperl(progfile => "t/lexical_debug.pl", stderr => 1 );
 
-print "1..10\n";
+print "1..12\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
@@ -25,11 +25,13 @@ 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 <boq>/, "Expect 'boq'"    );
+ok( $out !~ /EXACT <bor>/, "No 'bor'"        );
 ok( $out =~ /EXACT <fip>/, "Expect 'fip'"    );
 ok( $out !~ /EXACT <fop>/, "No 'baz'"        );
 ok( $out =~ /<liz>/,       "Got 'liz'"       ); # in a TRIE so no EXACT
 ok( $out =~ /<zoo>/,       "Got 'zoo'"       ); # in a TRIE so no EXACT
 ok( $out =~ /<zap>/,       "Got 'zap'"       ); # in a TRIE so no EXACT
-ok( $out =~ /Count=7\n/,   "Count is 7") 
+ok( $out =~ /Count=9\n/,   "Count is 9")
     or diag($out);
 
index e90a712..03c35a0 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 63;
+use Test::More tests => 67;
 
 my @flags = qw( a d l u );
 
@@ -53,6 +53,18 @@ no re '/sm';
 ok 'f r e l p' =~ /f r e l p/,
  "use re '/x' turns off when it drops out of scope";
 
+{
+  use re '/i';
+  ok "Foo" =~ /foo/, 'use re "/i"';
+  no re;
+  ok "Foo" !~ /foo/, "bare 'no re' reverts to no /i";
+  use re '/u';
+  my $nbsp = chr utf8::unicode_to_native(0xa0);
+  ok $nbsp =~ /\s/, 'nbsp matches \\s under /u';
+  no re;
+  ok $nbsp !~ /\s/, "bare 'no re' reverts to /d";
+}
+
 SKIP: {
   if (
       !$Config::Config{d_setlocale}
index dd9c811..6cafabb 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
 
 use strict;
 
-use Test::More tests => 9;
+use Test::More tests => 10;
 BEGIN { require_ok( 're' ); }
 
 {
@@ -29,6 +29,13 @@ BEGIN { require_ok( 're' ); }
         qr/\b*/;
 
         BEGIN { is(scalar @w, 1, 'use re "strict" turns on warnings'); }
+
+        BEGIN { undef @w; }
+
+        no re 'strict';
+        qr/\b*/;
+
+        BEGIN { is(scalar @w, 0, 'no re "strict" restores warnings state'); }
     }
 
     BEGIN {undef @w; }