From 5895685f42187a2d69e9327be74f715502e513bc Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Fri, 4 Mar 2011 21:55:46 +0000 Subject: Slight tweaks to regexp tests so that they still produce sane TAP with test.pl Explicitly escape non-printable characters in test descriptions, instead of relying on some part of the TAP generation code to do so. Use diag() instead of passing 3 arguments to ok(). Add a mininal diag() implementation to ReTest.pl --- t/re/ReTest.pl | 4 ++++ t/re/pat.t | 38 +++++++++++++++++++------------------- t/re/pat_advanced.t | 6 +++--- t/re/pat_rt_report.t | 16 ++++++++-------- 4 files changed, 34 insertions(+), 30 deletions(-) diff --git a/t/re/ReTest.pl b/t/re/ReTest.pl index b4338a6e1a..2d77a1c8fb 100644 --- a/t/re/ReTest.pl +++ b/t/re/ReTest.pl @@ -154,6 +154,10 @@ sub isneq ($$;$) { *is = \&iseq; *isnt = \&isneq; +sub diag { + print STDERR "# $_[0]\n"; +} + sub like ($$$) { my (undef, $expected, $name) = @_; my ($pass, $error); diff --git a/t/re/pat.t b/t/re/pat.t index e260af47f6..1cd801e67b 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -33,26 +33,26 @@ run_tests() unless caller; 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/]; } { @@ -84,7 +84,7 @@ sub run_tests { { # 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]; } { @@ -444,7 +444,7 @@ sub run_tests { 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); } @@ -966,11 +966,11 @@ sub run_tests { 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); } diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 82b3f63648..8eb872dc11 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -1042,7 +1042,7 @@ sub run_tests { 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'; @@ -1475,8 +1475,8 @@ sub run_tests { 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" diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t index a115264e7c..33ab876270 100644 --- a/t/re/pat_rt_report.t +++ b/t/re/pat_rt_report.t @@ -147,7 +147,7 @@ sub run_tests { # 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"); @@ -232,10 +232,10 @@ sub run_tests { $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; @@ -251,9 +251,9 @@ sub run_tests { 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]}"); } } } -- cgit v1.2.1