From: Nicholas Clark <nick@ccl4.org>
Date: Fri, 15 Apr 2011 15:03:58 +0000 (+0100)
Subject: Add a test for the non-exceptional warnings.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb53b4e72b2180d3610ce1e58bf0b45e6be2a9a9;p=p5sagit%2FDevel-Size.git

Add a test for the non-exceptional warnings.

Requires Test::PerlRun, which doesn't yet exist on CPAN. Otherwise it skips.
---

diff --git a/CHANGES b/CHANGES
index 2fa3df6..bd30e22 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,5 +1,8 @@
 Revision history for Perl extension Devel::Size.
 
+0.72_52 2111-04-15 nicholas
+ * Add a test for the non-exceptional warnings.
+
 0.72_51 2111-04-15 nicholas
  * Add PERL_NO_GET_CONTEXT to improve performance under multiplicity
 
diff --git a/MANIFEST b/MANIFEST
index 1907c49..a3c9511 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,3 +11,4 @@ t/basic.t
 t/pod.t
 t/pod_cov.t
 t/recurse.t
+t/warnings.t        A rather exhaustive test for the non-exceptional warnings
diff --git a/t/warnings.t b/t/warnings.t
new file mode 100644
index 0000000..60a04a9
--- /dev/null
+++ b/t/warnings.t
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+
+BEGIN {
+    # Not on CPAN yet. Interface may change. Mostly for my local use currently.
+    unless (eval 'use Test::PerlRun; 1') {
+	die $@ unless $@ =~ m!^Can't locate Test/PerlRun\.pm in \@INC!;
+	plan(skip_all => 'no Test::PerlRun found')
+    }
+}
+
+use Devel::Size ':all';
+
+my %warn = (
+	    F => "Devel::Size: Calculated sizes for FMs are incomplete\n",
+	    R => "Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be\n"
+	   );
+
+sub test_stdout {
+    my ($yell, $expecting, $what, $victim, $funcname, $expect) = @_;
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    $yell = "\$Devel::Size::warn = $yell\n;" if length $yell;
+    my $want = '';
+    if ($expecting) {
+	foreach (split //, $expect) {
+	    die "No warning for $_" unless $warn{$_};
+	    $want .= $warn{$_};
+	}
+    }
+
+    my $code = "$funcname($victim)";
+    my $desc = "For $what, $expect, $code";
+
+    perlrun_stdout_is({file => '-', stdin => <<"EOP"}, $want, $desc);
+use strict;
+use warnings;
+use blib;
+use Devel::Size ':all';
+
+format STDOUT =
+.
+
+format STDERR =
+.
+
+$yell;
+$code;
+EOP
+}
+
+my $formatref1 = '*STDOUT{FORMAT}';
+my $formatref2 = '*STDERR{FORMAT}';
+my $coderef = 'sub {//}';
+
+foreach (['', 1, 'defaults'], ['0', 0, 'yell = 0'], ['1', 1, 'yell = 1']) {
+    my ($yell, $expecting, $what) = @$_;
+    foreach(['[]', '', ''],
+	    [$formatref1, 'F', 'F'],
+	    [$coderef, 'R', 'R'],
+	    ["[$formatref1]", '', 'F'],
+	    ["[$formatref2]", '', 'F'],
+	    ["[$formatref1, $formatref2]", '', 'F'],
+	    ["[$coderef]", '', 'R'],
+	    ["[$coderef, $coderef]", '', 'R'],
+	    # The current implementation processes the list in reverse.
+	    ["[$formatref1, $coderef]", '', 'RF'],
+	    ["[$coderef, $formatref1]", '', 'FR'],
+	    ["[$formatref1, $coderef, $formatref2]", '', 'FR'],
+	    ["[$formatref1, $coderef, $formatref2, $coderef]", '', 'RF'],
+	    ["[$formatref1, $coderef, $coderef, $formatref2]", '', 'FR'],
+	    ["[$formatref1, $formatref2, $coderef, $coderef]", '', 'RF'],
+	    ["[$coderef, $formatref1]", '', 'FR'],
+	    ["[$coderef, $formatref1, $coderef]", '', 'RF'],
+	    ["[$coderef, $formatref1, $coderef, $formatref2]", '', 'FR'],
+	    ["[$coderef, $formatref1, $formatref2, $coderef]", '', 'RF'],
+	    ["[$coderef, $coderef, $formatref1, $formatref2]", '', 'FR'],
+	   ) {
+	my ($victim, $size, $total) = @$_;
+	test_stdout($yell, $expecting, $what, $victim, 'size', $size);
+	test_stdout($yell, $expecting, $what, $victim, 'total_size', $total);
+    }
+}
+
+done_testing();