sub run_tests {
{
-
my $x = "abc\ndef\n";
+ (my $x_pretty = $x) =~ s/\n/\\n/g;
- ok $x =~ /^abc/, qq ["$x" =~ /^abc/];
- ok $x !~ /^def/, qq ["$x" !~ /^def/];
+ ok $x =~ /^abc/, qq ["$x_pretty" =~ /^abc/];
+ ok $x !~ /^def/, qq ["$x_pretty" !~ /^def/];
# used to be a test for $*
- ok $x =~ /^def/m, qq ["$x" =~ /^def/m];
+ ok $x =~ /^def/m, qq ["$x_pretty" =~ /^def/m];
- nok $x =~ /^xxx/, qq ["$x" =~ /^xxx/];
- nok $x !~ /^abc/, qq ["$x" !~ /^abc/];
+ nok $x =~ /^xxx/, qq ["$x_pretty" =~ /^xxx/];
+ nok $x !~ /^abc/, qq ["$x_pretty" !~ /^abc/];
- ok $x =~ /def/, qq ["$x" =~ /def/];
- nok $x !~ /def/, qq ["$x" !~ /def/];
+ ok $x =~ /def/, qq ["$x_pretty" =~ /def/];
+ nok $x !~ /def/, qq ["$x_pretty" !~ /def/];
- ok $x !~ /.def/, qq ["$x" !~ /.def/];
- nok $x =~ /.def/, qq ["$x" =~ /.def/];
+ ok $x !~ /.def/, qq ["$x_pretty" !~ /.def/];
+ nok $x =~ /.def/, qq ["$x_pretty" =~ /.def/];
- ok $x =~ /\ndef/, qq ["$x" =~ /\ndef/];
- nok $x !~ /\ndef/, qq ["$x" !~ /\ndef/];
+ ok $x =~ /\ndef/, qq ["$x_pretty" =~ /\\ndef/];
+ nok $x !~ /\ndef/, qq ["$x_pretty" !~ /\\ndef/];
}
{
{
# used to be a test for $*
- ok "ab\ncd\n" =~ /^cd/m, qq ["ab\ncd\n" =~ /^cd/m];
+ ok "ab\ncd\n" =~ /^cd/m, q ["ab\ncd\n" =~ /^cd/m];
}
{
my $res = eval { "xx" =~ /(?$code)/o };
{
no warnings 'uninitialized';
- my $message = "$message '$@', '$res', '$blah'";
+ chomp $@; my $message = "$message '$@', '$res', '$blah'";
ok($@ && $@ =~ /not allowed at runtime/ && $blah == 12, $message);
}
sub new {bless []}
my $message = "Ref stringification";
- ::ok(do { \my $v} =~ /^SCALAR/, "Scalar ref stringification", $message);
- ::ok(do {\\my $v} =~ /^REF/, "Ref ref stringification", $message);
- ::ok([] =~ /^ARRAY/, "Array ref stringification", $message);
- ::ok({} =~ /^HASH/, "Hash ref stringification", $message);
- ::ok('S' -> new =~ /^Object S/, "Object stringification", $message);
+ ::ok(do { \my $v} =~ /^SCALAR/, "Scalar ref stringification") or diag($message);
+ ::ok(do {\\my $v} =~ /^REF/, "Ref ref stringification") or diag($message);
+ ::ok([] =~ /^ARRAY/, "Array ref stringification") or diag($message);
+ ::ok({} =~ /^HASH/, "Hash ref stringification") or diag($message);
+ ::ok('S' -> new =~ /^Object S/, "Object stringification") or diag($message);
}
undef $w;
eval q [ok "\0" !~ /[\N{EMPTY-STR}XY]/,
- "Zerolength charname in charclass doesn't match \\0"];
+ "Zerolength charname in charclass doesn't match \\\\0"];
ok $w && $w =~ /Ignoring zero length/,
'Ignoring zero length \N{} in character class warning';
ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Uppercase}/i, "i =~ Uppercase under /i";
ok "\N{SMALL ROMAN NUMERAL ONE}" !~ /\p{Titlecase}/, "i !~ Titlecase";
ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Titlecase}/i, "i =~ Titlecase under /i";
- ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/i, "I =~ Lowercase under
- /i";
+ ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/i, "I =~ Lowercase under /i";
+
ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/, "i =~ Lowercase";
ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDStart}/, "i =~ ID_Start";
ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "i =~ ID_Continue"
# Amazingly vertical tabulator is the same in ASCII and EBCDIC.
for ("\n", "\t", "\014", "\r") {
- unlike($_, qr/[[:print:]]/, "'$_' not in [[:print:]]; Bug 20010619.003");
+ unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003", ord $_);
}
for (" ") {
like($_, qr/[[:print:]]/, "'$_' in [[:print:]]; Bug 20010619.003");
$num =~ /\d/;
for (0 .. 1) {
my $match = m?? + 0;
- ok $match != $_, $message,
- sprintf "'match one' %s on %s iteration" =>
- $match ? 'succeeded' : 'failed',
- $_ ? 'second' : 'first';
+ ok($match != $_, $message)
+ or diag(sprintf "'match one' %s on %s iteration" =>
+ $match ? 'succeeded' : 'failed',
+ $_ ? 'second' : 'first');
}
$num =~ /(\d)/;
my $result = join "" => $num =~ //g;
for my $len (32000, 32768, 33000) {
my $s = $char . "f" x $len;
my $r = $s =~ /$char([f]*)/gc;
- ok $r, $message, "<$type x $len>";
- ok !$r || pos ($s) == $len + 1, $message,
- "<$type x $len>; pos = @{[pos $s]}";
+ ok($r, $message) or diag("<$type x $len>");
+ ok(!$r || pos ($s) == $len + 1, $message)
+ or diag("<$type x $len>; pos = @{[pos $s]}");
}
}
}