Proper fix for the lazy workaround in 7e1774f7
Dagfinn Ilmari Mannsåker [Mon, 8 Feb 2016 16:31:22 +0000 (16:31 +0000)]
Pure-perl subs return values as mortal copies on the stack, incrementing
the reference count until the next statement.  In the case of the last
statement in a sub, that is in the caller, after the other lexicals have
been GCed.

  if ( ... ) { ... };

counts as a single statement for this purpose, since it compiles to

  ( ... ) && do { ... };

The reason this doesn't bite when using XS is that Class::XSAcessor
returns the SV directly from the hash, rather than a mortal copy, so the
reference count never gets incremented.

Generalize the fix to a similar problem (8e9b9ce5) and pepper potentially
problematic codepaths with explicit NEXTSTATEs. Many of the changes do not
resolve anything as there is no "statement leakage" in most of this code,
but it is a good idea to have them there nevertheless: This way future
code-flow modifications will not accidentally reintroduce this problem.

lib/DBIx/Class/ResultSource.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Cursor.pm
lib/DBIx/Class/Storage/TxnScopeGuard.pm
lib/DBIx/Class/_Util.pm
t/lib/DBICTest/Util/LeakTracer.pm

index 03231c7..0940e0d 100644 (file)
@@ -2376,7 +2376,10 @@ sub DESTROY {
     $global_phase_destroy = 1;
   };
 
-  return;
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
index 4f595da..0be8919 100644 (file)
@@ -1462,6 +1462,11 @@ sub DESTROY {
       last;
     }
   }
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub _unregister_source {
index cdfc942..54dff81 100644 (file)
@@ -225,6 +225,11 @@ sub new {
     weaken (
       $seek_and_destroy{ refaddr($_[0]) } = $_[0]
     );
+
+    # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+    # collected before leaving this scope. Depending on the code above, this
+    # may very well be just a preventive measure guarding future modifications
+    undef;
   }
 
   END {
@@ -239,6 +244,11 @@ sub new {
       # disarm the handle if not native to this process (see comment on top)
       $_->_verify_pid for @instances;
     }
+
+    # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+    # collected before leaving this scope. Depending on the code above, this
+    # may very well be just a preventive measure guarding future modifications
+    undef;
   }
 
   sub CLONE {
@@ -255,6 +265,11 @@ sub new {
       # properly renumber existing refs
       $_->_arm_global_destructor
     }
+
+    # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+    # collected before leaving this scope. Depending on the code above, this
+    # may very well be just a preventive measure guarding future modifications
+    undef;
   }
 }
 
@@ -270,11 +285,10 @@ sub DESTROY {
   $_[0]->_dbh(undef);
   # not calling ->disconnect here - we are being destroyed - nothing to reset
 
-  # this op is necessary, since the very last perl runtime statement
-  # triggers a global destruction shootout, and the $SIG localization
-  # may very well be destroyed before perl actually gets to do the
-  # $dbh undef
-  1;
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 # handle pid changes correctly - do not destroy parent's connection
@@ -288,7 +302,10 @@ sub _verify_pid {
     $_[0]->disconnect;
   }
 
-  return;
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 =head2 connect_info
@@ -901,24 +918,7 @@ sub disconnect {
     #$self->_sql_maker(undef); # this may also end up being different
   };
 
-  # FIXME FIXME FIXME
-  # Something is wrong with CAG - it seems to delay GC in PP mode
-  # If the below if() is changed to:
-  #
-  #   if( $self->_dbh ) {
-  #
-  # The the following will reproducibly warn as the weakref in a $txn_guard
-  # is *NOT* deallocated by the time the $txn_guard destructor runs at
-  # https://github.com/dbsrgits/dbix-class/blob/84efb6d7/lib/DBIx/Class/Storage/TxnScopeGuard.pm#L82
-  #
-  # perl -Ilib -e '
-  #   BEGIN { warn $ENV{CAG_USE_XS} = ( time % 2 ) };
-  #   use DBIx::Class::Schema;
-  #   my $s = DBIx::Class::Schema->connect("dbi:SQLite::memory:");
-  #   my $g = $s->txn_scope_guard;
-  #   $s->storage->disconnect
-  # '
-  if( $self->{_dbh} ) { # do not use accessor - see above
+  if( $self->_dbh ) {
 
     $self->_do_connection_actions(disconnect_call_ => $_) for (
       ( $self->on_disconnect_call || () ),
@@ -928,6 +928,11 @@ sub disconnect {
     # stops the "implicit rollback on disconnect" warning
     $self->_exec_txn_rollback unless $self->_dbh_autocommit;
   }
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 =head2 with_deferred_fk_checks
index d900431..cac1529 100644 (file)
@@ -83,6 +83,11 @@ Returns a new L<DBIx::Class::Storage::DBI::Cursor> object.
 
       $self->{_intra_thread} = 1;
     }
+
+    # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+    # collected before leaving this scope. Depending on the code above, this
+    # may very well be just a preventive measure guarding future modifications
+    undef;
   }
 }
 
@@ -229,6 +234,11 @@ Resets the cursor to the beginning of the L<DBIx::Class::ResultSet>.
 sub reset {
   $_[0]->__finish_sth if $_[0]->{sth};
   $_[0]->sth(undef);
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 
@@ -236,6 +246,11 @@ sub DESTROY {
   return if &detected_reinvoked_destructor;
 
   $_[0]->__finish_sth if $_[0]->{sth};
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub __finish_sth {
@@ -262,6 +277,11 @@ sub __finish_sth {
       ! $self->{sth}->FETCH('Active')
     }
   );
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 =head1 FURTHER QUESTIONS?
index 111621b..31a2d5b 100644 (file)
@@ -105,6 +105,11 @@ sub DESTROY {
 
   $@ = $current_exception
     if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 1;
index 4a30060..4afa4c2 100644 (file)
@@ -318,6 +318,11 @@ sub is_exception ($) {
       { defined $_ ? ( refaddr($_) => $_ ) : () }
       values %$destruction_registry
     };
+
+    # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+    # collected before leaving this scope. Depending on the code above, this
+    # may very well be just a preventive measure guarding future modifications
+    undef;
   }
 
   # This is almost invariably invoked from within DESTROY
index ebde9f5..b1de109 100644 (file)
@@ -90,6 +90,11 @@ sub CLONE {
       $reg->{$new_addr} = $slot_info;
     }
   }
+
+  # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+  # collected before leaving this scope. Depending on the code above, this
+  # may very well be just a preventive measure guarding future modifications
+  undef;
 }
 
 sub visit_refs {