view release on metacpan or  search on metacpan

t/52leaks.t  view on Meta::CPAN

    leaky_resultset => $rs_bind_circref,
    leaky_resultset_cond => $cond_rowobj,
  };

  # fire all resultsets multiple times, once here, more below
  # some of these can't find anything (notably leaky_resultset)
  my @rsets = grep {
    blessed $_
      and
    (
      $_->isa('DBIx::Class::ResultSet')
        or
      $_->isa('DBIx::Class::ResultSetColumn')
    )
  } values %$base_collection;


  my $fire_resultsets = sub {
    local $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS} = 1;
    local $SIG{__WARN__} = sigwarn_silencer(
      qr/Unable to deflate 'filter'-type relationship 'artist'.+related object primary key not retrieved/
    );

    map
      { $_, (blessed($_) ? { $_->get_columns } : ()) }
      map
        { $_->all }
        @rsets
    ;
  };

  push @{$base_collection->{random_results}}, $fire_resultsets->();

  # FIXME - something throws a Storable for a spin if we keep
  # the results in-collection. The same problem is seen above,
  # swept under the rug back in 0a03206a, damned lazy ribantainer
{
  local $base_collection->{random_results};

  require Storable;
  %$base_collection = (
    %$base_collection,
    refrozen => Storable::dclone( $base_collection ),
    rerefrozen => Storable::dclone( Storable::dclone( $base_collection ) ),
    pref_row_implicit => $cds_with_impl_artist->next,
    schema => $schema,
    storage => $storage,
    sql_maker => $storage->sql_maker,
    dbh => $storage->_dbh,
    fresh_pager => $rs->page(5)->pager,
    pager => $pager,
  );
}

  # FIXME - ideally this kind of collector ought to be global, but attempts
  # with an invasive debugger-based tracer did not quite work out... yet
  # Manually scan the innards of everything we have in the base collection
  # we assembled so far (skip the DT madness below) *recursively*
  #
  # Only do this when we do have the bits to look inside CVs properly,
  # without it we are liable to pick up object defaults that are locked
  # in method closures
  #
  # Some elaborate SQLAC-replacements leak, do not worry about it for now
  if (
    DBICTest::Util::LeakTracer::CV_TRACING
      and
    ! $ENV{DBICTEST_SWAPOUT_SQLAC_WITH}
  ) {
    visit_refs(
      refs => [ $base_collection ],
      action => sub {
        populate_weakregistry ($weak_registry, $_[0]);
        1;  # true means "keep descending"
      },
    );

    # do a heavy-duty fire-and-compare loop on all resultsets
    # this is expensive - not running on install
    my $typecounts = {};
    if (
      ! DBICTest::RunMode->is_plain
        and
      ! $ENV{DBICTEST_IN_PERSISTENT_ENV}
    ) {

      # FIXME - ideally we should be able to just populate an alternative
      # registry, subtract everything from the main one, and arrive at
      # an "empty" resulting hash
      # However due to gross inefficiencies in the ::ResultSet code we
      # end up recalculating a new set of aliasmaps which could have very
      # well been cached if it wasn't for... anyhow
      # What we do here for the time being is similar to the lazy approach
      # of Devel::LeakTrace - we just make sure we do not end up with more
      # reftypes than when we started. At least we are not blanket-counting
      # SVs like D::LT does, but going by reftype... sigh...

      for (values %$weak_registry) {
        if ( my $r = reftype($_->{weakref}) ) {
          $typecounts->{$r}--;
        }
      }

      # For now we can only reuse the same registry, see FIXME above/below
      #for my $interim_wr ({}, {}) {
      for my $interim_wr ( ($weak_registry) x 4 ) {

        visit_refs(
          refs => [ $fire_resultsets->(), @rsets ],
          action => sub {
            populate_weakregistry ($interim_wr, $_[0]);
            1;  # true means "keep descending"
          },
        );

        # FIXME - this is what *should* be here
        #
        ## anything we have seen so far is cool
        #delete @{$interim_wr}{keys %$weak_registry};
        #
        ## moment of truth - the rest ought to be gone