make carp_once register messages not just callsite

Add a test as well in t/106dbic_carp.t .

diff --git a/Changes b/Changes
index 9b6a7ba..804b235 100644 (file)
--- a/Changes
+++ b/Changes
@@ -53,6 +53,8 @@ Revision history for DBIx::Class
         - Cleanup of complex resultset update/delete oprations - storage
           specific code moved back to ResultSet and replaced by checks
           of storage capabilities
+        - Fixed carp_once only emitting one single warning per package
+          regardless of warning content
 
 0.08196 2011-11-29 05:35 (UTC)
     * Fixes

diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
index 6bec374..ecd0864 100644 (file)
--- a/lib/DBIx/Class/Carp.pm
+++ b/lib/DBIx/Class/Carp.pm
@@ -81,10 +81,10 @@ sub import {
     );
   };
 
-  my $fired;
+  my $fired = {};
   *{"${into}::carp_once"} = sub {
-    return if $fired;
-    $fired = 1;
+    return if $fired->{$_[0]};
+    $fired->{$_[0]} = 1;
 
     $warn->(
       __find_caller($skip_pattern, $into),

diff --git a/t/106dbic_carp.t b/t/106dbic_carp.t
new file mode 100644 (file)
index 0000000..8bd65eb
--- /dev/null
+++ b/t/106dbic_carp.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Warn;
+use DBIx::Class::Carp;
+use lib 't/lib';
+use DBICTest;
+
+warnings_exist {
+  DBIx::Class::frobnicate();
+} [
+  qr/carp1/,
+  qr/carp2/,
+], 'expected warnings from carp_once';
+
+done_testing;
+
+sub DBIx::Class::frobnicate {
+  DBIx::Class::branch1();
+  DBIx::Class::branch2();
+}
+
+sub DBIx::Class::branch1 { carp_once 'carp1' }
+sub DBIx::Class::branch2 { carp_once 'carp2' }