iseq("$1$2","foobar");
}
{
+ local $Message = "HORIZWS";
local $_="\t \r\n \n \t".chr(11)."\n";
s/\H/H/g;
s/\h/h/g;
iseq($_,"hhHHhHhhHH");
}
{
+ local $Message = "Various whitespace special patterns";
my @h=map { chr( $_ ) } (
0x09, 0x20, 0xa0, 0x1680, 0x180e, 0x2000, 0x2001, 0x2002,
0x2003, 0x2004, 0x2005, 0x2006, 0x2007, 0x2008, 0x2009, 0x200a,
my $ary=shift @$t;
foreach my $pat (@$t) {
foreach my $str (@$ary) {
- ok($str=~/($pat)/);
- iseq($1,$str);
+ ok($str=~/($pat)/,$pat);
+ iseq($1,$str,$pat);
utf8::upgrade($str);
- ok($str=~/($pat)/);
- iseq($1,$str);
+ ok($str=~/($pat)/,"Upgraded string - $pat");
+ iseq($1,$str,"Upgraded string - $pat");
}
}
}
}
{
+ local $Message = "Check that \\xDF match properly in its various forms";
# test that \xDF matches properly. this is pretty hacky stuff,
# but its actually needed. the malarky with '-' is to prevent
# compilation caching from playing any role in the test.
}
}
}
+{
+ local $Message = "BBC(Bleadperl Breaks CPAN) Today: String::Multibyte";
+ my $re = qr/(?:[\x00-\xFF]{4})/;
+ my $hyp = "\0\0\0-";
+ my $esc = "\0\0\0\\";
+
+ my $str = "$esc$hyp$hyp$esc$esc";
+ my @a = ($str =~ /\G(?:\Q$esc$esc\E|\Q$esc$hyp\E|$re)/g);
+
+ iseq(0+@a,3);
+ iseq(join('=', @a),"$esc$hyp=$hyp=$esc$esc");
+}
+# test for keys in %+ and %-
+{
+ my $_ = "abcdef";
+ /(?<foo>a)|(?<foo>b)/;
+ iseq( (join ",", sort keys %+), "foo" );
+ iseq( (join ",", sort keys %-), "foo" );
+ iseq( (join ",", sort values %+), "a" );
+ iseq( (join ",", sort map "@$_", values %-), "a " );
+ /(?<bar>a)(?<bar>b)(?<quux>.)/;
+ iseq( (join ",", sort keys %+), "bar,quux" );
+ iseq( (join ",", sort keys %-), "bar,quux" );
+ iseq( (join ",", sort values %+), "a,c" ); # leftmost
+ iseq( (join ",", sort map "@$_", values %-), "a b,c" );
+ /(?<un>a)(?<deux>c)?/; # second buffer won't capture
+ iseq( (join ",", sort keys %+), "un" );
+ iseq( (join ",", sort keys %-), "deux,un" );
+ iseq( (join ",", sort values %+), "a" );
+ iseq( (join ",", sort map "@$_", values %-), ",a" );
+}
+
+# length() on captures, the numbered ones end up in Perl_magic_len
+{
+ my $_ = "aoeu \xe6var ook";
+ /^ \w+ \s (?<eek>\S+)/x;
+
+ iseq( length($`), 0, 'length $`' );
+ iseq( length($'), 4, q[length $'] );
+ iseq( length($&), 9, 'length $&' );
+ iseq( length($1), 4, 'length $1' );
+ iseq( length($+{eek}), 4, 'length $+{eek} == length $1' );
+}
+
+{
+ my $ok=-1;
+
+ $ok=exists($-{x}) ? 1 : 0
+ if 'bar'=~/(?<x>foo)|bar/;
+ iseq($ok,1,'$-{x} exists after "bar"=~/(?<x>foo)|bar/');
+ iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+ iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
+
+ $ok=-1;
+ $ok=exists($+{x}) ? 1 : 0
+ if 'bar'=~/(?<x>foo)|bar/;
+ iseq($ok,0,'$+{x} not exists after "bar"=~/(?<x>foo)|bar/');
+ iseq(scalar(%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+ iseq(scalar(%-), 1, 'scalar %- == 1 after "bar"=~/(?<x>foo)|bar/');
+
+ $ok=-1;
+ $ok=exists($-{x}) ? 1 : 0
+ if 'foo'=~/(?<x>foo)|bar/;
+ iseq($ok,1,'$-{x} exists after "foo"=~/(?<x>foo)|bar/');
+ iseq(scalar(%+), 1, 'scalar %+ == 1 after "foo"=~/(?<x>foo)|bar/');
+ iseq(scalar(%-), 1, 'scalar %- == 1 after "foo"=~/(?<x>foo)|bar/');
+
+ $ok=-1;
+ $ok=exists($+{x}) ? 1 : 0
+ if 'foo'=~/(?<x>foo)|bar/;
+ iseq($ok,1,'$+{x} exists after "foo"=~/(?<x>foo)|bar/');
+}
+
+
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
# Keep the following tests last -- they may crash perl
iseq($_,"!Bang!1!Bang!2!Bang!3!Bang!");
}
-# test for keys in %+ and %-
-{
- my $_ = "abcdef";
- /(?<foo>a)|(?<foo>b)/;
- iseq( (join ",", sort keys %+), "foo" );
- iseq( (join ",", sort keys %-), "foo" );
- iseq( (join ",", sort values %+), "a" );
- iseq( (join ",", sort map "@$_", values %-), "a " );
- /(?<bar>a)(?<bar>b)(?<quux>.)/;
- iseq( (join ",", sort keys %+), "bar,quux" );
- iseq( (join ",", sort keys %-), "bar,quux" );
- iseq( (join ",", sort values %+), "a,c" ); # leftmost
- iseq( (join ",", sort map "@$_", values %-), "a b,c" );
- /(?<un>a)(?<deux>c)?/; # second buffer won't capture
- iseq( (join ",", sort keys %+), "un" );
- iseq( (join ",", sort keys %-), "deux,un" );
- iseq( (join ",", sort values %+), "a" );
- iseq( (join ",", sort map "@$_", values %-), ",a" );
-}
-
-# length() on captures, these end up in Perl_magic_len
-{
- my $_ = "aoeu \xe6var ook";
- /^ \w+ \s (?<eek>\S+)/x;
-
- iseq( length($`), 0, 'length $`' );
- iseq( length($'), 4, q[length $'] );
- iseq( length($&), 9, 'length $&' );
- iseq( length($1), 4, 'length $1' );
- iseq( length($+{eek}), 4, 'length $+{eek} == length $1' );
-}
-
# Put new tests above the dotted line about a page above this comment
iseq(0+$::test,$::TestCount,"Got the right number of tests!");
# Don't forget to update this!
BEGIN {
- $::TestCount = 1948;
+ $::TestCount = 1960;
print "1..$::TestCount\n";
}
-
-