Increase $strict::VERSION to 1.05

[perl5.git] / lib / diagnostics.t

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 14014f6..4e5ab82 100644 (file)
--- a/lib/diagnostics.t
+++ b/lib/diagnostics.t
@@ -1,38 +1,68 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
     chdir '..' if -d '../pod' && -d '../t';
     @INC = 'lib';
 }
 
+use Test::More tests => 10;
 
-######################### We start with some black magic to print on failure.
+BEGIN {
+    my $w;
+    $SIG{__WARN__} = sub { $w = shift };
+    use_ok('diagnostics');
+    is $w, undef, 'no warnings when loading diagnostics.pm';
+}
 
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-use strict;
-use warnings;
+require base;
 
-use vars qw($Test_Num $Total_tests);
+eval {
+    'base'->import(qw(I::do::not::exist));
+};
 
-my $loaded;
-BEGIN { $| = 1; $Test_Num = 1 }
-END {print "not ok $Test_Num\n" unless $loaded;}
-print "1..$Total_tests\n";
-BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
-$loaded = 1;
-ok($loaded, 'compile');
-######################### End of black magic.
+like( $@, qr/^Base class package "I::do::not::exist" is empty/);
 
-sub ok {
-       my($test, $name) = shift;
-       print "not " unless $test;
-       print "ok $Test_Num";
-       print " - $name" if defined $name;
-       print "\n";
-       $Test_Num++;
-}
+# Test for %.0f patterns in perldiag, added in 5.11.0
+close STDERR;
+open STDERR, ">", \my $warning
+    or die "Couldn't redirect STDERR to var: $!";
+warn('gmtime(nan) too large');
+like $warning, qr/\(W overflow\) You called/, '%0.f patterns';
+
+# L<foo/bar> links
+seek STDERR, 0,0;
+$warning = '';
+warn("accept() on closed socket spanner");
+like $warning, qr/"accept" in perlfunc/, 'L<foo/bar> links';
+
+# L<foo|bar/baz> links
+seek STDERR, 0,0;
+$warning = '';
+warn
+ 'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
+like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
+
+# Multiple messages with the same description
+seek STDERR, 0,0;
+$warning = '';
+warn 'Code point 0x%X is not Unicode, may not be portable';
+like $warning, qr/W utf8/,
+   'Message sharing its description with the following message';
+
+# Periods at end of entries in perldiag.pod get matched correctly
+seek STDERR, 0,0;
+$warning = '';
+warn "Execution of -e aborted due to compilation errors.\n";
+like $warning, qr/The final summary message/, 'Periods at end of line';
 
+# Test for %d/%u
+seek STDERR, 0,0;
+$warning = '';
+warn "Bad arg length for us, is 4, should be 42";
+like $warning, qr/In C parlance/, '%u works';
 
-# Change this to your # of ok() calls + 1
-BEGIN { $Total_tests = 1 }
+# Strip S<>
+seek STDERR, 0,0;
+$warning = '';
+warn "syntax error";
+like $warning, qr/cybernetic version of 20 questions/s, 'strip S<>';