X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F106dbic_carp.t;h=f6bd91d8ac0b9efab76e155f41d30185ee677612;hb=wip%2Fmssql-2012-limit-dialect;hp=8bd65ebeaed255d56a3426e305f290e663660e5f;hpb=8fda97d562ef6a2fe8894078da7e2c96009279b5;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/106dbic_carp.t b/t/106dbic_carp.t
index 8bd65eb..f6bd91d 100644
--- a/t/106dbic_carp.t
+++ b/t/106dbic_carp.t
@@ -1,27 +1,80 @@
-#!/usr/bin/perl
-
 use strict;
 use warnings;
 
+# without this the stacktrace of $schema will be activated
+BEGIN { $ENV{DBIC_TRACE} = 0 }
+
 use Test::More;
 use Test::Warn;
-use DBIx::Class::Carp;
+use Test::Exception;
 use lib 't/lib';
 use DBICTest;
+use DBIx::Class::Carp;
 
-warnings_exist {
-  DBIx::Class::frobnicate();
-} [
-  qr/carp1/,
-  qr/carp2/,
-], 'expected warnings from carp_once';
+{
+  sub DBICTest::DBICCarp::frobnicate {
+    DBICTest::DBICCarp::branch1();
+    DBICTest::DBICCarp::branch2();
+  }
 
-done_testing;
+  sub DBICTest::DBICCarp::branch1 { carp_once 'carp1' }
+  sub DBICTest::DBICCarp::branch2 { carp_once 'carp2' }
+
+
+  warnings_exist {
+    DBICTest::DBICCarp::frobnicate();
+  } [
+    qr/carp1/,
+    qr/carp2/,
+  ], 'expected warnings from carp_once';
+}
 
-sub DBIx::Class::frobnicate {
-  DBIx::Class::branch1();
-  DBIx::Class::branch2();
+{
+  {
+    package DBICTest::DBICCarp::Exempt;
+    use DBIx::Class::Carp;
+
+    sub _skip_namespace_frames { qr/^DBICTest::DBICCarp::Exempt/ }
+
+    sub thrower {
+      sub {
+        DBICTest->init_schema(no_deploy => 1)->storage->dbh_do(sub {
+          shift->throw_exception('time to die');
+        })
+      }->();
+    }
+
+    sub dcaller {
+      sub {
+        thrower();
+      }->();
+    }
+
+    sub warner {
+      eval {
+        sub {
+          eval {
+            carp ('time to warn')
+          }
+        }->()
+      }
+    }
+
+    sub wcaller {
+      warner();
+    }
+  }
+
+  # the __LINE__ relationship below is important - do not reformat
+  throws_ok { DBICTest::DBICCarp::Exempt::dcaller() }
+    qr/\QDBICTest::DBICCarp::Exempt::thrower(): time to die at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
+    'Expected exception callsite and originator'
+  ;
+
+  # the __LINE__ relationship below is important - do not reformat
+  warnings_like { DBICTest::DBICCarp::Exempt::wcaller() }
+    qr/\QDBICTest::DBICCarp::Exempt::warner(): time to warn at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
+  ;
 }
 
-sub DBIx::Class::branch1 { carp_once 'carp1' }
-sub DBIx::Class::branch2 { carp_once 'carp2' }
+done_testing;