Commit | Line | Data |
fb53b4e7 |
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(); |