From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 27 May 2016 14:14:28 +0000 (+0200)
Subject: Annotate every indirect sugar-method
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1b822bd3;p=dbsrgits%2FDBIx-Class.git

Annotate every indirect sugar-method

Now that the churn is over we can add annotations to each method a user ought
to never override. See next commit for the actual use case and diagnostics
emitter.

Unfortunately this adds yet another small compile-time hit, similar to
73f54e27 (a hit incurred regardless whether the upcoming validation framework
is used or not). Complete test of DBIx::Class::Helpers v2.032002 goes from
about ~64.6 seconds CPU time up to ~65.5, adding another ~1% of startup speed
loss. The savings in debugging sessions should make this all worth it... or
so one hopes.
---

diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm
index 77cf852..5ccc109 100644
--- a/lib/DBIx/Class/AccessorGroup.pm
+++ b/lib/DBIx/Class/AccessorGroup.pm
@@ -9,12 +9,12 @@ use Scalar::Util 'blessed';
 use DBIx::Class::_Util 'fail_on_internal_call';
 use namespace::clean;
 
-sub mk_classdata {
+sub mk_classdata :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->mk_classaccessor(@_);
 }
 
-sub mk_classaccessor {
+sub mk_classaccessor :DBIC_method_is_indirect_sugar {
   my $self = shift;
   $self->mk_group_accessors('inherited', $_[0]);
   (@_ > 1)
diff --git a/lib/DBIx/Class/MethodAttributes.pm b/lib/DBIx/Class/MethodAttributes.pm
index 7ffe560..0dec0b3 100644
--- a/lib/DBIx/Class/MethodAttributes.pm
+++ b/lib/DBIx/Class/MethodAttributes.pm
@@ -143,8 +143,22 @@ sub MODIFY_CODE_ATTRIBUTES {
 sub VALID_DBIC_CODE_ATTRIBUTE {
   #my ($class, $attr) = @_;
 
-  # initially no valid attributes
-  0;
+###
+### !!! IMPORTANT !!!
+###
+### *DO NOT* yield to the temptation of using free-form-argument attributes.
+### The technique was proven instrumental in Catalyst a decade ago, and
+### was more recently revived in Sub::Attributes. Yet, while on the surface
+### they seem immensely useful, per-attribute argument lists are in fact an
+### architectural dead end.
+###
+### In other words: you are *very strongly urged* to ensure the regex below
+### does not allow anything beyond qr/^ DBIC_method_is_ [A-Z_a-z0-9]+ $/x
+###
+
+  $_[1] =~ /^ DBIC_method_is_ (?:
+    indirect_sugar
+  ) $/x;
 }
 
 sub FETCH_CODE_ATTRIBUTES {
@@ -200,11 +214,13 @@ L</VALID_DBIC_CODE_ATTRIBUTE> below.
 The following method attributes are currently recognized under the C<DBIC_*>
 prefix:
 
-=over
-
-=item * None so far
+=head3 DBIC_method_is_indirect_sugar
 
-=back
+The presence of this attribute indicates a helper "sugar" method. Overriding
+such methods in your subclasses will be of limited success at best, as DBIC
+itself and various plugins are much more likely to invoke alternative direct
+call paths, bypassing your override entirely. Good examples of this are
+L<DBIx::Class::ResultSet/create> and L<DBIx::Class::Schema/connect>.
 
 =head1 METHODS
 
diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index d281e00..a408b69 100644
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -104,20 +104,30 @@ EOC
   elsif ($acc_type eq 'multi') {
 
 
-    quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel );
+    my @qsub_args = (
+      {},
+      {
+        attributes => [qw(
+          DBIC_method_is_indirect_sugar
+        )]
+      },
+    );
+
+
+    quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel ), @qsub_args;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray;
       shift->related_resultset(%s)->search( @_ )
 EOC
 
 
-    quote_sub "${class}::${rel}_rs", sprintf( <<'EOC', perlstring $rel );
+    quote_sub "${class}::${rel}_rs", sprintf( <<'EOC', perlstring $rel ), @qsub_args;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
       shift->related_resultset(%s)->search_rs( @_ )
 EOC
 
 
-    quote_sub "${class}::add_to_${rel}", sprintf( <<'EOC', perlstring $rel );
+    quote_sub "${class}::add_to_${rel}", sprintf( <<'EOC', perlstring $rel ), @qsub_args;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
       shift->create_related( %s => @_ );
 EOC
diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 994e7d7..007676e 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -611,7 +611,7 @@ See L<DBIx::Class::ResultSet/search_related> for more information.
 
 =cut
 
-sub search_related {
+sub search_related :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->related_resultset(shift)->search(@_);
 }
@@ -623,7 +623,7 @@ it guarantees a resultset, even in list context.
 
 =cut
 
-sub search_related_rs {
+sub search_related_rs :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->related_resultset(shift)->search_rs(@_)
 }
@@ -643,7 +643,7 @@ current result or where conditions.
 
 =cut
 
-sub count_related {
+sub count_related :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->related_resultset(shift)->search_rs(@_)->count;
 }
@@ -720,7 +720,7 @@ See L<DBIx::Class::ResultSet/find> for details.
 
 =cut
 
-sub find_related {
+sub find_related :DBIC_method_is_indirect_sugar {
   #my ($self, $rel, @args) = @_;
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   return shift->related_resultset(shift)->find(@_);
@@ -785,7 +785,7 @@ L<DBIx::Class::ResultSet/update_or_create> for details.
 
 =cut
 
-sub update_or_create_related {
+sub update_or_create_related :DBIC_method_is_indirect_sugar {
   #my ($self, $rel, @args) = @_;
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->related_resultset(shift)->update_or_create(@_);
diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm
index 0c31ebb..fdd4697 100644
--- a/lib/DBIx/Class/Relationship/ManyToMany.pm
+++ b/lib/DBIx/Class/Relationship/ManyToMany.pm
@@ -56,7 +56,15 @@ EOW
       }
     }
 
-    quote_sub "${class}::${meth}", sprintf( <<'EOC', $rs_meth );
+    my @main_meth_qsub_args = (
+      {},
+      { attributes => [
+        'DBIC_method_is_indirect_sugar',
+      ] },
+    );
+
+
+    quote_sub "${class}::${meth}", sprintf( <<'EOC', $rs_meth ), @main_meth_qsub_args;
 
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray;
@@ -67,13 +75,18 @@ EOW
 EOC
 
 
-    my $qsub_attrs = {
-      '$rel_attrs' => \{ alias => $f_rel, %{ $rel_attrs||{} } },
-      '$carp_unique' => \$cu,
-    };
+    my @extra_meth_qsub_args = (
+      {
+        '$rel_attrs' => \{ alias => $f_rel, %{ $rel_attrs||{} } },
+        '$carp_unique' => \$cu,
+      },
+      { attributes => [
+        'DBIC_method_is_indirect_sugar',
+      ] },
+    );
 
 
-    quote_sub "${class}::${rs_meth}", sprintf( <<'EOC', map { perlstring $_ } ( "${class}::${meth}", $rel, $f_rel ) ), $qsub_attrs;
+    quote_sub "${class}::${rs_meth}", sprintf( <<'EOC', map { perlstring $_ } ( "${class}::${meth}", $rel, $f_rel ) ), @extra_meth_qsub_args;
 
       DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
         and
@@ -95,8 +108,11 @@ EOC
       ;
 EOC
 
+    # the above is the only indirect method, the 3 below have too much logic
+    shift @{$extra_meth_qsub_args[1]{attributes}};
 
-    quote_sub "${class}::${add_meth}", sprintf( <<'EOC', $add_meth, $rel, $f_rel ), $qsub_attrs;
+
+    quote_sub "${class}::${add_meth}", sprintf( <<'EOC', $add_meth, $rel, $f_rel ), @extra_meth_qsub_args;
 
       ( @_ >= 2 and @_ <= 3 ) or $_[0]->throw_exception(
         "'%1$s' expects an object or hashref to link to, and an optional hashref of link data"
@@ -140,7 +156,7 @@ EOC
 EOC
 
 
-    quote_sub "${class}::${set_meth}", sprintf( <<'EOC', $set_meth, $add_meth, $rel, $f_rel ), $qsub_attrs;
+    quote_sub "${class}::${set_meth}", sprintf( <<'EOC', $set_meth, $add_meth, $rel, $f_rel ), @extra_meth_qsub_args;
 
       my $self = shift;
 
@@ -190,8 +206,7 @@ EOC
       $guard->commit if $guard;
 EOC
 
-
-    quote_sub "${class}::${remove_meth}", sprintf( <<'EOC', $remove_meth, $rel, $f_rel );
+    quote_sub "${class}::${remove_meth}", sprintf( <<'EOC', $remove_meth, $rel, $f_rel ), @extra_meth_qsub_args;
 
       $_[0]->throw_exception("'%1$s' expects an object")
         unless defined Scalar::Util::blessed( $_[1] );
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 2c5131d..3d06065 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -986,7 +986,7 @@ See also L</search_related_rs>.
 
 =cut
 
-sub search_related {
+sub search_related :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   return shift->related_resultset(shift)->search(@_);
 }
@@ -998,7 +998,7 @@ it guarantees a resultset, even in list context.
 
 =cut
 
-sub search_related_rs {
+sub search_related_rs :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   return shift->related_resultset(shift)->search_rs(@_);
 }
@@ -1769,7 +1769,7 @@ with the passed arguments, then L</count>.
 
 =cut
 
-sub count_literal {
+sub count_literal :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->search_literal(@_)->count
 }
@@ -1849,7 +1849,7 @@ an object for the first result (or C<undef> if the resultset is empty).
 
 =cut
 
-sub first {
+sub first :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   return $_[0]->reset->next;
 }
@@ -2867,7 +2867,7 @@ L</new>.
 
 =cut
 
-sub create {
+sub create :DBIC_method_is_indirect_sugar {
   #my ($self, $col_data) = @_;
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   return shift->new_result(shift)->insert;
diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm
index 71cd52c..a514139 100644
--- a/lib/DBIx/Class/ResultSetColumn.pm
+++ b/lib/DBIx/Class/ResultSetColumn.pm
@@ -278,7 +278,7 @@ resultset (or C<undef> if there are none).
 
 =cut
 
-sub min {
+sub min :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func('MIN');
 }
@@ -299,7 +299,7 @@ Wrapper for ->func_rs for function MIN().
 
 =cut
 
-sub min_rs {
+sub min_rs :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func_rs('MIN')
 }
@@ -321,7 +321,7 @@ resultset (or C<undef> if there are none).
 
 =cut
 
-sub max {
+sub max :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func('MAX');
 }
@@ -342,7 +342,7 @@ Wrapper for ->func_rs for function MAX().
 
 =cut
 
-sub max_rs {
+sub max_rs :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func_rs('MAX')
 }
@@ -364,7 +364,7 @@ the resultset. Use on varchar-like columns at your own risk.
 
 =cut
 
-sub sum {
+sub sum :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func('SUM');
 }
@@ -385,7 +385,7 @@ Wrapper for ->func_rs for function SUM().
 
 =cut
 
-sub sum_rs {
+sub sum_rs :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->func_rs('SUM')
 }
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index f8a1661..85d0bfc 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -704,7 +704,7 @@ sub add_columns {
   return $self;
 }
 
-sub add_column {
+sub add_column :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->add_columns(@_)
 }
@@ -748,7 +748,7 @@ contents of the hashref.
 
 =cut
 
-sub column_info {
+sub column_info :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
   #my ($self, $column) = @_;
@@ -912,7 +912,7 @@ sub remove_columns {
   $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]);
 }
 
-sub remove_column {
+sub remove_column :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->remove_columns(@_)
 }
@@ -1143,7 +1143,7 @@ See also L</add_unique_constraint>.
 
 =cut
 
-sub add_unique_constraints {
+sub add_unique_constraints :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
   my $self = shift;
@@ -1606,7 +1606,7 @@ Returns the L<storage handle|DBIx::Class::Storage> for the current schema.
 
 =cut
 
-sub storage {
+sub storage :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   $_[0]->schema->storage
 }
diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index cfd37ca..cd18d2e 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -6,6 +6,9 @@ use warnings;
 
 use base 'DBIx::Class';
 
+# needs to be loaded early to query method attributes below
+use DBIx::Class::ResultSource;
+
 use DBIx::Class::_Util qw( quote_sub fail_on_internal_call );
 use namespace::clean;
 
@@ -38,7 +41,7 @@ sub add_columns {
   }
 }
 
-sub add_column {
+sub add_column :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->add_columns(@_)
 }
@@ -53,7 +56,7 @@ sub add_relationship {
 
 
 # legacy resultset_class accessor, seems to be used by cdbi only
-sub iterator_class {
+sub iterator_class :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->result_source->resultset_class(@_)
 }
@@ -89,7 +92,13 @@ for my $method_to_proxy (qw/
   relationship_info
   has_relationship
 /) {
-  quote_sub __PACKAGE__."::$method_to_proxy", sprintf( <<'EOC', $method_to_proxy );
+
+  my $qsub_opts = { attributes => [ do {
+    no strict 'refs';
+    attributes::get( \&{"DBIx::Class::ResultSource::$method_to_proxy"} )
+  } ] };
+
+  quote_sub __PACKAGE__."::$method_to_proxy", sprintf( <<'EOC', $method_to_proxy ), {}, $qsub_opts;
     DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
 
     shift->result_source->%s (@_);
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 1097701..7ccebb4 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -1359,7 +1359,7 @@ Alias for L</update_or_insert>
 
 =cut
 
-sub insert_or_update {
+sub insert_or_update :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->update_or_insert(@_);
 }
@@ -1429,7 +1429,7 @@ Accessor to the L<DBIx::Class::ResultSource> this object was created from.
 
 =cut
 
-sub result_source {
+sub result_source :DBIC_method_is_indirect_sugar {
   # While getter calls are routed through here for sensible exception text
   # it makes no sense to have setters do the same thing
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 45dcd7e..618b585 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -552,7 +552,7 @@ version, overload L</connection> instead.
 
 =cut
 
-sub connect {
+sub connect :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->clone->connection(@_);
 }
@@ -835,7 +835,7 @@ those values.
 
 =cut
 
-sub populate {
+sub populate :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
 
   my ($self, $name, $data) = @_;
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index d949b01..c8f0180 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -25,7 +25,7 @@ __PACKAGE__->mk_group_accessors(component_class => 'cursor_class');
 
 __PACKAGE__->cursor_class('DBIx::Class::Cursor');
 
-sub cursor {
+sub cursor :DBIC_method_is_indirect_sugar {
   DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
   shift->cursor_class(@_);
 }
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 7f3549d..e94d98d 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -1065,6 +1065,42 @@ sub fail_on_internal_call {
     : $fr
   ;
 
+
+  die "\nMethod $fr->[3] is not marked with the 'DBIC_method_is_indirect_sugar' attribute\n\n" unless (
+
+    # unlikely but who knows...
+    ! @$fr
+
+      or
+
+    # This is a weird-ass double-purpose method, only one branch of which is marked
+    # as an illegal indirect call
+    # Hence the 'indirect' attribute makes no sense
+    # FIXME - likely need to mark this in some other manner
+    $fr->[3] eq 'DBIx::Class::ResultSet::new'
+
+      or
+
+    # RsrcProxy stuff is special and not attr-annotated on purpose
+    # Yet it is marked (correctly) as fail_on_internal_call(), as DBIC
+    # itself should not call these methods as first-entry
+    $fr->[3] =~ /^DBIx::Class::ResultSourceProxy::[^:]+$/
+
+      or
+
+    # FIXME - there is likely a more fine-graned way to escape "foreign"
+    # callers, based on annotations... (albeit a slower one)
+    # For the time being just skip in a dumb way
+    $fr->[3] !~ /^DBIx::Class|^DBICx::|^DBICTest::/
+
+      or
+
+    grep
+      { $_ eq 'DBIC_method_is_indirect_sugar' }
+      do { no strict 'refs'; attributes::get( \&{ $fr->[3] }) }
+  );
+
+
   if (
     defined $fr->[0]
       and
diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 5f52f75..6c293cc 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -443,6 +443,12 @@ sub connection {
         };
 
         weaken( $assertion_arounds->{refaddr $replacement} = $replacement );
+
+        attributes->import(
+          $origin,
+          $replacement,
+          attributes::get($orig_rsrc)
+        );
       }
 
 
@@ -518,8 +524,13 @@ sub connection {
         };
 
         weaken( $assertion_arounds->{refaddr $replacement} = $replacement );
-      }
 
+        attributes->import(
+          $origin,
+          $replacement,
+          attributes::get($orig_rsrc_instance)
+        );
+      }
     }
 
     Class::C3::initialize if DBIx::Class::_ENV_::OLD_MRO;