This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dae2754b0d421aed3c17fd6553ac173cf57d3bef
[perl5.git] / lib / diagnostics.t
1 #!./perl
2
3 BEGIN {
4     chdir '..' if -d '../pod' && -d '../t';
5     @INC = 'lib';
6 }
7
8 use Test::More tests => 6;
9
10 BEGIN { use_ok('diagnostics') }
11
12 require base;
13
14 eval {
15     'base'->import(qw(I::do::not::exist));
16 };
17
18 like( $@, qr/^Base class package "I::do::not::exist" is empty/);
19
20 # Test for %.0f patterns in perldiag, added in 5.11.0
21 close STDERR;
22 open STDERR, ">", \my $warning
23     or die "Couldn't redirect STDERR to var: $!";
24 warn('gmtime(nan) too large');
25 like $warning, qr/\(W overflow\) You called/, '%0.f patterns';
26
27 # L<foo/bar> links
28 seek STDERR, 0,0;
29 $warning = '';
30 warn("accept() on closed socket spanner");
31 like $warning, qr/"accept" in perlfunc/, 'L<foo/bar> links';
32
33 # L<foo|bar/baz> links
34 seek STDERR, 0,0;
35 $warning = '';
36 warn
37  'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
38 like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
39
40 # Multiple messages with the same description
41 seek STDERR, 0,0;
42 $warning = '';
43 warn 'Code point 0x%X is not Unicode, may not be portable';
44 like $warning, qr/W utf8/,
45    'Message sharing its description with the following message';
46