Add a comment to force emacs to use C mode.
[p5sagit/Devel-Size.git] / t / warnings.t
CommitLineData
fb53b4e7 1#!/usr/bin/perl -w
2
3use strict;
4use Test::More;
5
6BEGIN {
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
14use Devel::Size ':all';
15
16my %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
21sub 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);
37use strict;
38use warnings;
39use blib;
40use Devel::Size ':all';
41
42format STDOUT =
43.
44
45format STDERR =
46.
47
48$yell;
49$code;
50EOP
51}
52
53my $formatref1 = '*STDOUT{FORMAT}';
54my $formatref2 = '*STDERR{FORMAT}';
55my $coderef = 'sub {//}';
56
57foreach (['', 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
86done_testing();