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 => 9;
   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
  59 # Test for %d/%u
  60 seek STDERR, 0,0;
  61 $warning = '';
  62 warn "Bad arg length for us, is 4, should be 42";
  63 like $warning, qr/In C parlance/, '%u works';