-#!/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;