t/warnings.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More;
   5
   6 BEGIN {
   7     # Not on CPAN yet. Interface may change. Mostly for my local use currently.
   8     unless (eval 'use Test::PerlRun; 1') {
   9         die $@ unless $@ =~ m!^Can't locate Test/PerlRun\.pm in \@INC!;
  10         plan(skip_all => 'no Test::PerlRun found')
  11     }
  12 }
  13
  14 use Devel::Size ':all';
  15
  16 my %warn = (
  17             F => "Devel::Size: Calculated sizes for FMs are incomplete\n",
  18             R => "Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be\n"
  19            );
  20
  21 sub test_stdout {
  22     my ($yell, $expecting, $what, $victim, $funcname, $expect) = @_;
  23     local $Test::Builder::Level = $Test::Builder::Level + 1;
  24     $yell = "\$Devel::Size::warn = $yell\n;" if length $yell;
  25     my $want = '';
  26     if ($expecting) {
  27         foreach (split //, $expect) {
  28             die "No warning for $_" unless $warn{$_};
  29             $want .= $warn{$_};
  30         }
  31     }
  32
  33     my $code = "$funcname($victim)";
  34     my $desc = "For $what, $expect, $code";
  35
  36     perlrun_stdout_is({file => '-', stdin => <<"EOP"}, $want, $desc);
  37 use strict;
  38 use warnings;
  39 use blib;
  40 use Devel::Size ':all';
  41
  42 format STDOUT =
  43 .
  44
  45 format STDERR =
  46 .
  47
  48 $yell;
  49 $code;
  50 EOP
  51 }
  52
  53 my $formatref1 = '*STDOUT{FORMAT}';
  54 my $formatref2 = '*STDERR{FORMAT}';
  55 my $coderef = 'sub {//}';
  56
  57 foreach (['', 1, 'defaults'], ['0', 0, 'yell = 0'], ['1', 1, 'yell = 1']) {
  58     my ($yell, $expecting, $what) = @$_;
  59     foreach(['[]', '', ''],
  60             [$formatref1, 'F', 'F'],
  61             [$coderef, 'R', 'R'],
  62             ["[$formatref1]", '', 'F'],
  63             ["[$formatref2]", '', 'F'],
  64             ["[$formatref1, $formatref2]", '', 'F'],
  65             ["[$coderef]", '', 'R'],
  66             ["[$coderef, $coderef]", '', 'R'],
  67             # The current implementation processes the list in reverse.
  68             ["[$formatref1, $coderef]", '', 'RF'],
  69             ["[$coderef, $formatref1]", '', 'FR'],
  70             ["[$formatref1, $coderef, $formatref2]", '', 'FR'],
  71             ["[$formatref1, $coderef, $formatref2, $coderef]", '', 'RF'],
  72             ["[$formatref1, $coderef, $coderef, $formatref2]", '', 'FR'],
  73             ["[$formatref1, $formatref2, $coderef, $coderef]", '', 'RF'],
  74             ["[$coderef, $formatref1]", '', 'FR'],
  75             ["[$coderef, $formatref1, $coderef]", '', 'RF'],
  76             ["[$coderef, $formatref1, $coderef, $formatref2]", '', 'FR'],
  77             ["[$coderef, $formatref1, $formatref2, $coderef]", '', 'RF'],
  78             ["[$coderef, $coderef, $formatref1, $formatref2]", '', 'FR'],
  79            ) {
  80         my ($victim, $size, $total) = @$_;
  81         test_stdout($yell, $expecting, $what, $victim, 'size', $size);
  82         test_stdout($yell, $expecting, $what, $victim, 'total_size', $total);
  83     }
  84 }
  85
  86 done_testing();