{
$_ = 'now is the {time for all} good men to come to.';
/ {([^}]*)}/;
- iseq $1, 'time for all', "Match braces";
+ is($1, 'time for all', "Match braces");
}
{
$t9++ if /$pat9/o;
}
my $x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
- iseq $x, '505550555', "Test /o";
+ is($x, '505550555', "Test /o");
}
$_ .= '';
my @x = /abc/g;
- iseq @x, 2, "/g reset after assignment";
+ is(@x, 2, "/g reset after assignment");
}
{
{
$_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
my @out = /(?<!foo)bar./g;
- iseq "@out", 'bar2 barf', "Negative lookbehind";
+ is("@out", 'bar2 barf', "Negative lookbehind");
}
{
{
my @ans = ('a/b' =~ m%(.*/)?(.*)%); # Stack may be bad
- iseq "@ans", 'a/ b', "Stack may be bad";
+ is("@ans", 'a/ b', "Stack may be bad");
}
{
}
{
- iseq qr/\b\v$/i, '(?^i:\b\v$)', 'qr/\b\v$/i';
- iseq qr/\b\v$/s, '(?^s:\b\v$)', 'qr/\b\v$/s';
- iseq qr/\b\v$/m, '(?^m:\b\v$)', 'qr/\b\v$/m';
- iseq qr/\b\v$/x, '(?^x:\b\v$)', 'qr/\b\v$/x';
- iseq qr/\b\v$/xism, '(?^msix:\b\v$)', 'qr/\b\v$/xism';
- iseq qr/\b\v$/, '(?^:\b\v$)', 'qr/\b\v$/';
+ is(qr/\b\v$/i, '(?^i:\b\v$)', 'qr/\b\v$/i');
+ is(qr/\b\v$/s, '(?^s:\b\v$)', 'qr/\b\v$/s');
+ is(qr/\b\v$/m, '(?^m:\b\v$)', 'qr/\b\v$/m');
+ is(qr/\b\v$/x, '(?^x:\b\v$)', 'qr/\b\v$/x');
+ is(qr/\b\v$/xism, '(?^msix:\b\v$)', 'qr/\b\v$/xism');
+ is(qr/\b\v$/, '(?^:\b\v$)', 'qr/\b\v$/');
}
{ # Test that charset modifier work, and are interpolated
- iseq qr/\b\v$/, '(?^:\b\v$)', 'Verify no locale, no unicode_strings gives default modifier';
- iseq qr/(?l:\b\v$)/, '(?^:(?l:\b\v$))', 'Verify infix l modifier compiles';
- iseq qr/(?u:\b\v$)/, '(?^:(?u:\b\v$))', 'Verify infix u modifier compiles';
- iseq qr/(?l)\b\v$/, '(?^:(?l)\b\v$)', 'Verify (?l) compiles';
- iseq qr/(?u)\b\v$/, '(?^:(?u)\b\v$)', 'Verify (?u) compiles';
+ is(qr/\b\v$/, '(?^:\b\v$)', 'Verify no locale, no unicode_strings gives default modifier');
+ is(qr/(?l:\b\v$)/, '(?^:(?l:\b\v$))', 'Verify infix l modifier compiles');
+ is(qr/(?u:\b\v$)/, '(?^:(?u:\b\v$))', 'Verify infix u modifier compiles');
+ is(qr/(?l)\b\v$/, '(?^:(?l)\b\v$)', 'Verify (?l) compiles');
+ is(qr/(?u)\b\v$/, '(?^:(?u)\b\v$)', 'Verify (?u) compiles');
my $dual = qr/\b\v$/;
use locale;
my $locale = qr/\b\v$/;
- iseq $locale, '(?^l:\b\v$)', 'Verify has l modifier when compiled under use locale';
+ is($locale, '(?^l:\b\v$)', 'Verify has l modifier when compiled under use locale');
no locale;
use feature 'unicode_strings';
my $unicode = qr/\b\v$/;
- iseq $unicode, '(?^u:\b\v$)', 'Verify has u modifier when compiled under unicode_strings';
- iseq qr/abc$dual/, '(?^u:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale';
- iseq qr/abc$locale/, '(?^u:abc(?^l:\b\v$))', 'Verify retains l when interpolated under unicode_strings';
+ is($unicode, '(?^u:\b\v$)', 'Verify has u modifier when compiled under unicode_strings');
+ is(qr/abc$dual/, '(?^u:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale');
+ is(qr/abc$locale/, '(?^u:abc(?^l:\b\v$))', 'Verify retains l when interpolated under unicode_strings');
no feature 'unicode_strings';
- iseq qr/abc$locale/, '(?^:abc(?^l:\b\v$))', 'Verify retains l when interpolated outside locale and unicode strings';
- iseq qr/def$unicode/, '(?^:def(?^u:\b\v$))', 'Verify retains u when interpolated outside locale and unicode strings';
+ is(qr/abc$locale/, '(?^:abc(?^l:\b\v$))', 'Verify retains l when interpolated outside locale and unicode strings');
+ is(qr/def$unicode/, '(?^:def(?^u:\b\v$))', 'Verify retains u when interpolated outside locale and unicode strings');
use locale;
- iseq qr/abc$dual/, '(?^l:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale';
- iseq qr/abc$unicode/, '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale';
+ is(qr/abc$dual/, '(?^l:abc(?^:\b\v$))', 'Verify retains d meaning when interpolated under locale');
+ is(qr/abc$unicode/, '(?^l:abc(?^u:\b\v$))', 'Verify retains u when interpolated under locale');
}
$_ = '123x123';
my @res = /(\d*|x)/g;
local $" = '|';
- iseq "@res", "123||x|123|", "0 match in alternation";
+ is("@res", "123||x|123|", "0 match in alternation");
}
my $text = "abc dbf";
my @res = ($text =~ /.*?(b).*?\b/g);
- iseq "@res", "b b", '\b is not special';
+ is("@res", "b b", '\b is not special');
}
# When this happens the tests can be removed
no warnings 'syntax';
- iseq( eval q#my $r = "a" =~ m/a/lt 2;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by lt");
- iseq( eval q#my $r = "a" =~ m/a/le 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by le");
- iseq( eval q#my $r = "a" =~ m/a/eq 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by eq");
- iseq( eval q#my $r = "a" =~ m/a/ne 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by ne");
- iseq( eval q#my $r = "a" =~ m/a/and 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by and");
- iseq( eval q#my $r = "a" =~ m/a/unless 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by unless");
- iseq( eval q#my $c = 1; my $r; $r = "a" =~ m/a/while $c--;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by while");
- iseq( eval q#my $c = 0; my $r; $r = "a" =~ m/a/until $c++;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by until");
- iseq( eval q#my $r; $r = "a" =~ m/a/for 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by for");
- iseq( eval q#my $r; $r = "a" =~ m/a/foreach 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by foreach");
-
- iseq( eval q#my $t = "a"; my $r = $t =~ s/a//lt 2;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by lt");
- iseq( eval q#my $t = "a"; my $r = $t =~ s/a//le 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by le");
- iseq( eval q#my $t = "a"; my $r = $t =~ s/a//ne 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by ne");
- iseq( eval q#my $t = "a"; my $r = $t =~ s/a//and 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by and");
- iseq( eval q#my $t = "a"; my $r = $t =~ s/a//unless 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by unless");
-
- iseq( eval q#my $c = 1; my $r; my $t = "a"; $r = $t =~ s/a//while $c--;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by while");
- iseq( eval q#my $c = 0; my $r; my $t = "a"; $r = $t =~ s/a//until $c++;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by until");
- iseq( eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by for");
- iseq( eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by foreach");
+ is(eval q#my $r = "a" =~ m/a/lt 2;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by lt");
+ is(eval q#my $r = "a" =~ m/a/le 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by le");
+ is(eval q#my $r = "a" =~ m/a/eq 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by eq");
+ is(eval q#my $r = "a" =~ m/a/ne 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by ne");
+ is(eval q#my $r = "a" =~ m/a/and 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by and");
+ is(eval q#my $r = "a" =~ m/a/unless 0;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by unless");
+ is(eval q#my $c = 1; my $r; $r = "a" =~ m/a/while $c--;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by while");
+ is(eval q#my $c = 0; my $r; $r = "a" =~ m/a/until $c++;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by until");
+ is(eval q#my $r; $r = "a" =~ m/a/for 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by for");
+ is(eval q#my $r; $r = "a" =~ m/a/foreach 1;"eval_ok $r"#, "eval_ok 1", "regex (m//) followed by foreach");
+
+ is(eval q#my $t = "a"; my $r = $t =~ s/a//lt 2;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by lt");
+ is(eval q#my $t = "a"; my $r = $t =~ s/a//le 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by le");
+ is(eval q#my $t = "a"; my $r = $t =~ s/a//ne 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by ne");
+ is(eval q#my $t = "a"; my $r = $t =~ s/a//and 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by and");
+ is(eval q#my $t = "a"; my $r = $t =~ s/a//unless 0;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by unless");
+
+ is(eval q#my $c = 1; my $r; my $t = "a"; $r = $t =~ s/a//while $c--;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by while");
+ is(eval q#my $c = 0; my $r; my $t = "a"; $r = $t =~ s/a//until $c++;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by until");
+ is(eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by for");
+ is(eval q#my $r; my $t = "a"; $r = $t =~ s/a//for 1;"eval_ok $r"#, "eval_ok 1", "regex (s///) followed by foreach");
}
{
my $str= "\x{100}";
chop $str;
my $qr= qr/$str/;
- iseq( "$qr", "(?^:)", "Empty pattern qr// stringifies to (?^:) with unicode flag enabled - Bug #80212" );
+ is("$qr", "(?^:)", "Empty pattern qr// stringifies to (?^:) with unicode flag enabled - Bug #80212");
$str= "";
$qr= qr/$str/;
- iseq( "$qr", "(?^:)", "Empty pattern qr// stringifies to (?^:) with unicode flag disabled - Bug #80212" )
+ is("$qr", "(?^:)", "Empty pattern qr// stringifies to (?^:) with unicode flag disabled - Bug #80212");
}
"A" =~ /(((A))?)+/;
my $second = $2;
- iseq($first, $second);
+ is($first, $second);
}
{
# Japhy -- added 03/03/2001
() = (my $str = "abc") =~ /(...)/;
$str = "def";
- iseq $1, "abc", 'Changing subject does not modify $1';
+ is($1, "abc", 'Changing subject does not modify $1');
}
{ok(($x =~ /(([ace])|([bdf]))*/ and $^N eq "f"), $message);}
## Test to see if $^N is automatically localized -- it should now
## have the value set in the previous test.
- iseq $^N, "e", '$^N is automatically localized';
+ is($^N, "e", '$^N is automatically localized');
# Now test inside (?{ ... })
$message = '$^N usage inside (?{ ... })';
{ # TRIE related
our @got = ();
"words" =~ /(word|word|word)(?{push @got, $1})s$/;
- iseq @got, 1, "TRIE optimisation";
+ is(@got, 1, "TRIE optimisation");
@got = ();
"words" =~ /(word|word|word)(?{push @got,$1})s$/i;
- iseq @got, 1,"TRIEF optimisation";
+ is(@got, 1,"TRIEF optimisation");
my @nums = map {int rand 1000} 1 .. 100;
my $re = "(" . (join "|", @nums) . ")";
local $_ = '<<<stuff1>and<stuff2>><<<<right>>>>>';
ok /^(<((?:(?>[^<>]+)|(?1))*)>(?{push @stack, $2 }))$/,
"Recursion matches";
- iseq @stack, @expect, "Right amount of matches"
+ is(@stack, @expect, "Right amount of matches")
or skip "Won't test individual results as count isn't equal",
0 + @expect;
my $idx = 0;
foreach my $expect (@expect) {
- iseq $stack [$idx], $expect,
- "Expecting '$expect' at stack pos #$idx";
+ is($stack [$idx], $expect,
+ "Expecting '$expect' at stack pos #$idx");
$idx ++;
}
}
}
}
my @expect = qw (A:0:1 A:1:3 B:0:2 B:1:4);
- iseq "@res", "@expect", "Check %-";
+ is("@res", "@expect", "Check %-");
eval'
no warnings "uninitialized";
print for $- {this_key_doesnt_exist};
{ # Test the (*PRUNE) pattern
our $count = 0;
'aaab' =~ /a+b?(?{$count++})(*FAIL)/;
- iseq $count, 9, "Expect 9 for no (*PRUNE)";
+ is($count, 9, "Expect 9 for no (*PRUNE)");
$count = 0;
'aaab' =~ /a+b?(*PRUNE)(?{$count++})(*FAIL)/;
- iseq $count, 3, "Expect 3 with (*PRUNE)";
+ is($count, 3, "Expect 3 with (*PRUNE)");
local $_ = 'aaab';
$count = 0;
1 while /.(*PRUNE)(?{$count++})(*FAIL)/g;
- iseq $count, 4, "/.(*PRUNE)/";
+ is($count, 4, "/.(*PRUNE)/");
$count = 0;
'aaab' =~ /a+b?(??{'(*PRUNE)'})(?{$count++})(*FAIL)/;
- iseq $count, 3, "Expect 3 with (*PRUNE)";
+ is($count, 3, "Expect 3 with (*PRUNE)");
local $_ = 'aaab';
$count = 0;
1 while /.(??{'(*PRUNE)'})(?{$count++})(*FAIL)/g;
- iseq $count, 4, "/.(*PRUNE)/";
+ is($count, 4, "/.(*PRUNE)/");
}
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a+b?(*SKIP)(?{$count++})(*FAIL)/;
- iseq $count, 1, "Expect 1 with (*SKIP)";
+ is($count, 1, "Expect 1 with (*SKIP)");
local $_ = 'aaab';
$count = 0;
1 while /.(*SKIP)(?{$count++})(*FAIL)/g;
- iseq $count, 4, "/.(*SKIP)/";
+ is($count, 4, "/.(*SKIP)/");
$_ = 'aaabaaab';
$count = 0;
our @res = ();
1 while /(a+b?)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
- iseq $count, 2, "Expect 2 with (*SKIP)";
- iseq "@res", "aaab aaab", "Adjacent (*SKIP) works as expected";
+ is($count, 2, "Expect 2 with (*SKIP)");
+ is("@res", "aaab aaab", "Adjacent (*SKIP) works as expected");
}
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a+b?(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/;
- iseq $count, 1, "Expect 1 with (*SKIP)";
+ is($count, 1, "Expect 1 with (*SKIP)");
local $_ = 'aaab';
$count = 0;
1 while /.(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/g;
- iseq $count, 4, "/.(*SKIP)/";
+ is($count, 4, "/.(*SKIP)/");
$_ = 'aaabaaab';
$count = 0;
our @res = ();
1 while /(a+b?)(*MARK:foo)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
- iseq $count, 2, "Expect 2 with (*SKIP)";
- iseq "@res", "aaab aaab", "Adjacent (*SKIP) works as expected";
+ is($count, 2, "Expect 2 with (*SKIP)");
+ is("@res", "aaab aaab", "Adjacent (*SKIP) works as expected");
}
{ # Test the (*SKIP) pattern
our $count = 0;
'aaab' =~ /a*(*MARK:a)b?(*MARK:b)(*SKIP:a)(?{$count++})(*FAIL)/;
- iseq $count, 3, "Expect 3 with *MARK:a)b?(*MARK:b)(*SKIP:a)";
+ is($count, 3, "Expect 3 with *MARK:a)b?(*MARK:b)(*SKIP:a)");
local $_ = 'aaabaaab';
$count = 0;
our @res = ();
1 while
/(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
- iseq $count, 5, "Expect 5 with (*MARK:a)b?)(*MARK:x)(*SKIP:a)";
- iseq "@res", "aaab b aaab b ",
- "Adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected";
+ is($count, 5, "Expect 5 with (*MARK:a)b?)(*MARK:x)(*SKIP:a)");
+ is("@res", "aaab b aaab b ",
+ "Adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected");
}
{ # Test the (*COMMIT) pattern
our $count = 0;
'aaabaaab' =~ /a+b?(*COMMIT)(?{$count++})(*FAIL)/;
- iseq $count, 1, "Expect 1 with (*COMMIT)";
+ is($count, 1, "Expect 1 with (*COMMIT)");
local $_ = 'aaab';
$count = 0;
1 while /.(*COMMIT)(?{$count++})(*FAIL)/g;
- iseq $count, 1, "/.(*COMMIT)/";
+ is($count, 1, "/.(*COMMIT)/");
$_ = 'aaabaaab';
$count = 0;
our @res = ();
1 while /(a+b?)(*COMMIT)(?{$count++; push @res,$1})(*FAIL)/g;
- iseq $count, 1, "Expect 1 with (*COMMIT)";
- iseq "@res", "aaab", "Adjacent (*COMMIT) works as expected";
+ is($count, 1, "Expect 1 with (*COMMIT)");
+ is("@res", "aaab", "Adjacent (*COMMIT) works as expected");
}
"(*COMMIT$name)") {
for my $suffix ('(*FAIL)', '') {
'aaaab' =~ /a+b$pat$suffix/;
- iseq $REGERROR,
+ is($REGERROR,
($suffix ? ($name ? 'foo' : "1") : ""),
- "Test $pat and \$REGERROR $suffix";
+ "Test $pat and \$REGERROR $suffix");
}
}
}
"(*COMMIT$name)") {
for my $suffix ('(*FAIL)','') {
'aaaab' =~ /a+b$pat$suffix/;
- ::iseq $REGERROR,
+ ::is($REGERROR,
($suffix ? ($name ? 'foo' : "1") : ""),
- "Test $pat and \$REGERROR $suffix";
+ "Test $pat and \$REGERROR $suffix");
}
}
}
local $_ = join 'bar', $spaces, $spaces;
our $count = 0;
s/(?>\s+bar)(?{$count++})//g;
- iseq $_, $spaces, "SUSPEND final string";
- iseq $count, 1, "Optimiser should have prevented more than one match";
+ is($_, $spaces, "SUSPEND final string");
+ is($count, 1, "Optimiser should have prevented more than one match");
}
my $time_string = "D\x{e9} C\x{e9}adaoin";
eval $parser;
ok !$@, "Test Eval worked";
- iseq $dow_name, $time_string, "UTF-8 trie common prefix extraction";
+ is($dow_name, $time_string, "UTF-8 trie common prefix extraction");
}
my $v;
($v = 'bar') =~ /(\w+)/g;
$v = 'foo';
- iseq "$1", 'bar', '$1 is safe after /g - may fail due ' .
- 'to specialized config in pp_hot.c'
+ is("$1", 'bar',
+ '$1 is safe after /g - may fail due to specialized config in pp_hot.c');
}
our $grabit = qr/ ([0-6][0-9]{7}) (??{ kt $1 }) [890] /x;
$re = qr/^ ( (??{ $grabit }) ) $ /x;
my @res = '0902862349' =~ $re;
- iseq join ("-", @res), "0902862349",
- 'PL_curpm is set properly on nested eval';
+ is(join ("-", @res), "0902862349",
+ 'PL_curpm is set properly on nested eval');
our $qr = qr/ (o) (??{ $1 }) /x;
ok 'boob'=~/( b (??{ $qr }) b )/x && 1, "PL_curpm, nested eval";
if ('1' =~ /(?|(?<digit>1)|(?<digit>2))/) {
$res = "@{$- {digit}}";
}
- iseq $res, "1",
- "Check that (?|...) doesnt cause dupe entries in the names array";
+ is($res, "1",
+ "Check that (?|...) doesnt cause dupe entries in the names array");
$res = "";
if ('11' =~ /(?|(?<digit>1)|(?<digit>2))(?&digit)/) {
$res = "@{$- {digit}}";
}
- iseq $res, "1", "Check that (?&..) to a buffer inside " .
- "a (?|...) goes to the leftmost";
+ is($res, "1",
+ "Check that (?&..) to a buffer inside a (?|...) goes to the leftmost");
}
foreach my $pat (@$t) {
foreach my $str (@$ary) {
ok $str =~ /($pat)/, $pat;
- iseq $1, $str, $pat;
+ is($1, $str, $pat);
utf8::upgrade ($str);
ok $str =~ /($pat)/, "Upgraded string - $pat";
- iseq $1, $str, "Upgraded string - $pat";
+ is($1, $str, "Upgraded string - $pat");
}
}
}
my $_ = "aoeu \xe6var ook";
/^ \w+ \s (?<eek>\S+)/x;
- iseq length ($`), 0, q[length $`];
- iseq length ($'), 4, q[length $'];
- iseq length ($&), 9, q[length $&];
- iseq length ($1), 4, q[length $1];
- iseq length ($+{eek}), 4, q[length $+{eek} == length $1];
+ is(length $`, 0, q[length $`]);
+ is(length $', 4, q[length $']);
+ is(length $&, 9, q[length $&]);
+ is(length $1, 4, q[length $1]);
+ is(length $+{eek}, 4, q[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/';
+ is($ok, 1, '$-{x} exists after "bar"=~/(?<x>foo)|bar/');
+ is(scalar (%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+ is(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/';
+ is($ok, 0, '$+{x} not exists after "bar"=~/(?<x>foo)|bar/');
+ is(scalar (%+), 0, 'scalar %+ == 0 after "bar"=~/(?<x>foo)|bar/');
+ is(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/';
+ is($ok, 1, '$-{x} exists after "foo"=~/(?<x>foo)|bar/');
+ is(scalar (%+), 1, 'scalar %+ == 1 after "foo"=~/(?<x>foo)|bar/');
+ is(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/';
+ is($ok, 1, '$+{x} exists after "foo"=~/(?<x>foo)|bar/');
}
local $_;
($_ = 'abc') =~ /(abc)/g;
$_ = '123';
- iseq "$1", 'abc', "/g leads to unsafe match vars: $1";
+ is("$1", 'abc', "/g leads to unsafe match vars: $1");
}
'a' =~ /(a|)/;
push @x, 1;
}
- iseq length ($str), 0, "Trie scope error, string should be empty";
+ is(length $str, 0, "Trie scope error, string should be empty");
$str = "";
my @foo = ('a') x 5;
for (@foo) {
$str .= "@bar";
s/a|/push @bar, 1/e;
}
- iseq length ($str), 0, "Trie scope error, string should be empty";
+ is(length $str, 0, "Trie scope error, string should be empty");
}
{
our $a = 3; "" =~ /(??{ $a })/;
our $b = $a;
- iseq $b, $a, "Copy of scalar used for postponed subexpression";
+ is($b, $a, "Copy of scalar used for postponed subexpression");
}
my $match = '<bla><blubb></blubb></bla>' =~ m/^$nested_tags$/;
ok $match, 'nested construct matches';
- iseq "@ctl_n", "bla blubb", '$^N inside of (?{}) works as expected';
- iseq "@plus", "bla blubb", '$+ inside of (?{}) works as expected';
+ is("@ctl_n", "bla blubb", '$^N inside of (?{}) works as expected');
+ is("@plus", "bla blubb", '$+ inside of (?{}) works as expected');
}
my @notIsPunct = grep {/[[:punct:]]/ and not /\p{IsPunct}/}
map {chr} 0x20 .. 0x7f;
- iseq join ('', @notIsPunct), '$+<=>^`|~',
- '[:punct:] disagrees with IsPunct on Symbols';
+ is(join ('', @notIsPunct), '$+<=>^`|~',
+ '[:punct:] disagrees with IsPunct on Symbols');
my @isPrint = grep {not /[[:print:]]/ and /\p{IsPrint}/}
map {chr} 0 .. 0x1f, 0x7f .. 0x9f;
- iseq join ('', @isPrint), "",
- 'IsPrint agrees with [:print:] on control characters';
+ is(join ('', @isPrint), "",
+ 'IsPrint agrees with [:print:] on control characters');
my @isPunct = grep {/[[:punct:]]/ != /\p{IsPunct}/}
map {chr} 0x80 .. 0xff;
- iseq join ('', @isPunct), "\xa1\xab\xb7\xbb\xbf", # ¡ « · » ¿
- 'IsPunct disagrees with [:punct:] outside ASCII';
+ is(join ('', @isPunct), "\xa1\xab\xb7\xbb\xbf", # ¡ « · » ¿
+ 'IsPunct disagrees with [:punct:] outside ASCII');
my @isPunctLatin1 = eval q {
use encoding 'latin1';
skip "Eval failed ($@)", 1 if $@;
skip "PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS set to 0", 1
if !$ENV{PERL_TEST_LEGACY_POSIX_CC};
- iseq join ('', @isPunctLatin1), '',
- 'IsPunct agrees with [:punct:] with explicit Latin1';
+ is(join ('', @isPunctLatin1), '',
+ 'IsPunct agrees with [:punct:] with explicit Latin1');
}
my $match_a = ($re->[1] =~ $re->[2]) || 0;
my $match_b = ($re->[1] =~ $re->[3]) || 0;
- iseq($match_a, $re->[0], "match a " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
- iseq($match_b, $re->[0], "match b " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
- iseq($count_a, $re->[4], "count a ($c)");
- iseq($count_b, $re->[4], "count b ($c)");
+ is($match_a, $re->[0], "match a " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
+ is($match_b, $re->[0], "match b " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
+ is($count_a, $re->[4], "count a ($c)");
+ is($count_b, $re->[4], "count b ($c)");
}
}