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];
}
}
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};
warnings::warn("regexp", $message);
}
}
+
+ if ($turning_all_off) {
+ _load_unload(0);
+ $^H{reflags} = 0;
+ $^H{reflags_charset} = 0;
+ $^H &= ~$flags_hint;
+ }
+
$bits;
}
use re 'debug';
-$_ = 'foo bar baz bop fip fop';
+$_ = 'foo bar baz bop boq bor fip fop';
/foo/ and $count++;
/bop/ and $count++;
}
+{
+ use re 'debug';
+ /boq/ and $count++;
+ no re;
+ /bor/ and $count++;
+}
+
/fip/ and $count++;
no re 'debug';
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
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);
use strict;
-use Test::More tests => 63;
+use Test::More tests => 67;
my @flags = qw( a d l u );
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}
use strict;
-use Test::More tests => 9;
+use Test::More tests => 10;
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; }