This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Strip S<> formatting codes from diagnostics output
[perl5.git] / lib / diagnostics.t
1 #!./perl -w
2
3 BEGIN {
4     chdir '..' if -d '../pod' && -d '../t';
5     @INC = 'lib';
6 }
7
8 use Test::More tests => 10;
9
10 BEGIN {
11     my $w;
12     $SIG{__WARN__} = sub { $w = shift };
13     use_ok('diagnostics');
14     is $w, undef, 'no warnings when loading diagnostics.pm';
15 }
16
17 require base;
18
19 eval {
20     'base'->import(qw(I::do::not::exist));
21 };
22
23 like( $@, qr/^Base class package "I::do::not::exist" is empty/);
24
25 # Test for %.0f patterns in perldiag, added in 5.11.0
26 close STDERR;
27 open STDERR, ">", \my $warning
28     or die "Couldn't redirect STDERR to var: $!";
29 warn('gmtime(nan) too large');
30 like $warning, qr/\(W overflow\) You called/, '%0.f patterns';
31
32 # L<foo/bar> links
33 seek STDERR, 0,0;
34 $warning = '';
35 warn("accept() on closed socket spanner");
36 like $warning, qr/"accept" in perlfunc/, 'L<foo/bar> links';
37
38 # L<foo|bar/baz> links
39 seek STDERR, 0,0;
40 $warning = '';
41 warn
42  'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
43 like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
44
45 # Multiple messages with the same description
46 seek STDERR, 0,0;
47 $warning = '';
48 warn 'Code point 0x%X is not Unicode, may not be portable';
49 like $warning, qr/W utf8/,
50    'Message sharing its description with the following message';
51
52 # Periods at end of entries in perldiag.pod get matched correctly
53 seek STDERR, 0,0;
54 $warning = '';
55 warn "Execution of -e aborted due to compilation errors.\n";
56 like $warning, qr/The final summary message/, 'Periods at end of line';
57
58 # Test for %d/%u
59 seek STDERR, 0,0;
60 $warning = '';
61 warn "Bad arg length for us, is 4, should be 42";
62 like $warning, qr/In C parlance/, '%u works';
63
64 # Strip S<>
65 seek STDERR, 0,0;
66 $warning = '';
67 warn "syntax error";
68 like $warning, qr/cybernetic version of 20 questions/s, 'strip S<>';