use Fcntl qw(:DEFAULT :seek :flock);
use IO::Handle ();
-use DBIx::Class::_Util 'scope_guard';
+use DBIx::Class::_Util qw( emit_loud_diag scope_guard set_subname get_subname );
use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry);
use DBICTest::Util qw( local_umask tmpdir await_flock dbg DEBUG_TEST_CONCURRENCY_LOCKS );
+use Scalar::Util qw( refaddr weaken );
use namespace::clean;
if( $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION} ) {
my $ea = __PACKAGE__->exception_action( sub {
- my ( $fr_num, $disarmed, $throw_exception_fr_num );
+ # Can not rely on $^S here at all - the exception_action
+ # itself is always called in an eval so that the goto-guard
+ # can work (see 7cb35852)
+
+ my ( $fr_num, $disarmed, $throw_exception_fr_num, $eval_fr_num );
while( ! $disarmed and my @fr = caller(++$fr_num) ) {
$throw_exception_fr_num ||= (
- $fr[3] eq 'DBIx::Class::ResultSource::throw_exception'
+ $fr[3] =~ /^DBIx::Class::(?:ResultSource|Schema|Storage|Exception)::throw(?:_exception)?$/
+ and
+ # there may be evals in the throwers themselves - skip those
+ ( $eval_fr_num ) = ( undef )
+ and
+ $fr_num
+ );
+
+ # now that the above stops un-setting us, we can find the first
+ # ineresting eval
+ $eval_fr_num ||= (
+ $fr[3] eq '(eval)'
and
$fr_num
);
'',
' You almost certainly used eval/try instead of dbic_internal_try()',
" Adjust *one* of the eval-ish constructs in the callstack starting" . DBICTest::Util::stacktrace($throw_exception_fr_num||())
- ) unless $disarmed;
+ ) if (
+ ! $disarmed
+ and
+ (
+ $eval_fr_num
+ or
+ ! $throw_exception_fr_num
+ )
+ );
DBIx::Class::Exception->throw( $_[0] );
});
# without this there would be false positives everywhere :(
die @_ if (
+ # blindly rethrow if nobody is waiting for us
+ ( defined $^S and ! $^S )
+ or
(caller(0))[0] !~ $interesting_ns_rx
or
(
caller(0) eq 'main'
and
- (caller(1))[0] !~ $interesting_ns_rx
+ ( (caller(1))[0] || '' ) !~ $interesting_ns_rx
)
);
}
}
-my $weak_registry = {};
+my ( $weak_registry, $assertion_arounds ) = ( {}, {} );
+
+sub DBICTest::__RsrcRedefiner_iThreads_handler__::CLONE {
+ if( DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE ) {
+ %$assertion_arounds = map {
+ (defined $_)
+ ? ( refaddr($_) => $_ )
+ : ()
+ } values %$assertion_arounds;
+
+ weaken($_) for values %$assertion_arounds;
+ }
+}
sub connection {
my $self = shift->next::method(@_);
# we need to work with a forced fresh clone so that we do not upset any state
# of the main $schema (some tests examine it quite closely)
local $SIG{__WARN__} = sub {};
- local $SIG{__DIE__};
+ local $SIG{__DIE__} if $SIG{__DIE__};
local $@;
# this will either give us an undef $locktype or will determine things
]);
}
+ #
+ # Check an explicit level of indirection: makes sure that folks doing
+ # use `base "DBIx::Class::Core"; __PACKAGE__->add_column("foo")`
+ # will see the correct error message
+ #
+ # In the future this all is likely to be folded into a single method in
+ # some way, but that's a fight for another maint
+ #
+ if( DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE ) {
+
+ for my $class_of_interest (
+ 'DBIx::Class::Row',
+ map { $self->class($_) } ($self->sources)
+ ) {
+
+ my $orig_rsrc = $class_of_interest->can('result_source')
+ or die "How did we get here?!";
+
+ unless ( $assertion_arounds->{refaddr $orig_rsrc} ) {
+
+ my ($origin) = get_subname($orig_rsrc);
+
+ no warnings 'redefine';
+ no strict 'refs';
+
+ *{"${origin}::result_source"} = my $replacement = set_subname "${origin}::result_source" => sub {
+
+
+ @_ > 1
+ and
+ (CORE::caller(0))[1] !~ / (?: ^ | [\/\\] ) x?t [\/\\] .+? \.t $ /x
+ and
+ emit_loud_diag(
+ msg => 'Incorrect indirect call of result_source() as setter must be changed to result_source_instance()',
+ confess => 1,
+ );
+
+
+ grep {
+ ! (CORE::caller($_))[7]
+ and
+ ( (CORE::caller($_))[3] || '' ) eq '(eval)'
+ and
+ ( (CORE::caller($_))[1] || '' ) !~ / (?: ^ | [\/\\] ) x?t [\/\\] .+? \.t $ /x
+ } (0..2)
+ and
+ # these evals are legit
+ ( (CORE::caller(4))[3] || '' ) !~ /^ (?:
+ DBIx::Class::Schema::_ns_get_rsrc_instance
+ |
+ DBIx::Class::Relationship::BelongsTo::belongs_to
+ |
+ DBIx::Class::Relationship::HasOne::_has_one
+ |
+ Class::C3::Componentised::.+
+ ) $/x
+ and
+ emit_loud_diag(
+ # not much else we can do (aside from exit(1) which is too obnoxious)
+ msg => 'Incorrect call of result_source() in an eval',
+ );
+
+
+ &$orig_rsrc;
+ };
+
+ weaken( $assertion_arounds->{refaddr $replacement} = $replacement );
+ }
+
+
+ # no rsrc_instance to mangle
+ next if $class_of_interest eq 'DBIx::Class::Row';
+
+
+ my $orig_rsrc_instance = $class_of_interest->can('result_source_instance')
+ or die "How did we get here?!";
+
+ # Do the around() per definition-site as result_source_instance is a CAG inherited cref
+ unless ( $assertion_arounds->{refaddr $orig_rsrc_instance} ) {
+
+ my ($origin) = get_subname($orig_rsrc_instance);
+
+ no warnings 'redefine';
+ no strict 'refs';
+
+ *{"${origin}::result_source_instance"} = my $replacement = set_subname "${origin}::result_source_instance" => sub {
+
+
+ @_ == 1
+ and
+ # special cased as we do not care whether there is a source
+ ( (CORE::caller(4))[3] || '' ) ne 'DBIx::Class::Schema::_register_source'
+ and
+ # special case because I am paranoid
+ ( (CORE::caller(4))[3] || '' ) ne 'DBIx::Class::Row::throw_exception'
+ and
+ ( (CORE::caller(1))[3] || '' ) !~ / ^ DBIx::Class:: (?:
+ Row::result_source
+ |
+ Row::throw_exception
+ |
+ ResultSourceProxy::Table:: (?: _init_result_source_instance | table )
+ |
+ ResultSourceHandle::STORABLE_thaw
+ ) $ /x
+ and
+ (CORE::caller(0))[1] !~ / (?: ^ | [\/\\] ) x?t [\/\\] .+? \.t $ /x
+ and
+ emit_loud_diag(
+ msg => 'Incorrect direct call of result_source_instance() as getter must be changed to result_source()',
+ confess => 1
+ );
+
+
+ grep {
+ ! (CORE::caller($_))[7]
+ and
+ ( (CORE::caller($_))[3] || '' ) eq '(eval)'
+ and
+ ( (CORE::caller($_))[1] || '' ) !~ / (?: ^ | [\/\\] ) x?t [\/\\] .+? \.t $ /x
+ } (0..2)
+ and
+ # special cased as we do not care whether there is a source
+ ( (CORE::caller(4))[3] || '' ) ne 'DBIx::Class::Schema::_register_source'
+ and
+ # special case because I am paranoid
+ ( (CORE::caller(4))[3] || '' ) ne 'DBIx::Class::Row::throw_exception'
+ and
+ # special case for Storable, which in turn calls from an eval
+ ( (CORE::caller(1))[3] || '' ) ne 'DBIx::Class::ResultSourceHandle::STORABLE_thaw'
+ and
+ emit_loud_diag(
+ # not much else we can do (aside from exit(1) which is too obnoxious)
+ msg => 'Incorrect call of result_source_instance() in an eval',
+ skip_frames => 1,
+ show_dups => 1,
+ );
+
+ &$orig_rsrc_instance;
+ };
+
+ weaken( $assertion_arounds->{refaddr $replacement} = $replacement );
+ }
+
+ }
+
+ Class::C3::initialize if DBIx::Class::_ENV_::OLD_MRO;
+ }
+ #
+ # END Check an explicit level of indirection
+
return $self;
}
projects / dbsrgits/DBIx-Class.git / blobdiff