Fix the DESTROY/discard_changes() infinite recursion at the DBIC level.

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index 2a68df5..b2efdf8 100644 (file)
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -39,14 +39,21 @@ sub discard_changes {
   my ($self) = @_;
   delete $self->{_dirty_columns};
   return unless $self->in_storage; # Don't reload if we aren't real!
-  my ($reload) = $self->result_source->resultset->find
-    (map { $self->$_ } $self->primary_columns);
+
+  my $reload = $self->result_source->resultset->find(
+    map { $self->$_ } $self->primary_columns
+  );
   unless ($reload) { # If we got deleted in the mean-time
     $self->in_storage(0);
     return $self;
   }
-  delete @{$self}{keys %$self};
-  @{$self}{keys %$reload} = values %$reload;
+
+  %$self = %$reload;
+  
+  # Avoid a possible infinite loop with
+  # sub DESTROY { $_[0]->discard_changes }
+  bless $reload, 'Do::Not::Exist';
+
   return $self;
 }
 

diff --git a/t/discard_changes_in_DESTROY.t b/t/discard_changes_in_DESTROY.t
index 950d9bd..946b060 100644 (file)
--- a/t/discard_changes_in_DESTROY.t
+++ b/t/discard_changes_in_DESTROY.t
@@ -1,29 +1,32 @@
 #!/usr/bin/perl -w
 
 use strict;
+use warnings;  
+
 use Test::More;
+use lib qw(t/lib);
+use DBICTest;
 
-BEGIN {
-  eval "use DBIx::Class::CDBICompat;";
-  plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
-          : (tests=> 1);
-}
+my $schema = DBICTest->init_schema();
 
-INIT {
-    use lib 't/testlib';
-    use Film;
-}
+plan tests => 1;
 
 {
     my @warnings;
     local $SIG{__WARN__} = sub { push @warnings, @_; };
     {
         # Test that this doesn't cause infinite recursion.
-        local *Film::DESTROY;
-        local *Film::DESTROY = sub { $_[0]->discard_changes };
+        local *DBICTest::Artist::DESTROY;
+        local *DBICTest::Artist::DESTROY = sub { $_[0]->discard_changes };
+        
+        my $artist = $schema->resultset("Artist")->create( { 
+            artistid    => 10,
+            name        => "artist number 10",
+        });
+        
+        $artist->name("Wibble");
         
-        my $film = Film->insert({ Title => "Eegah!" });
-        $film->director("Arch Hall Sr.");
+        print "# About to call DESTROY\n";
     }
     is_deeply \@warnings, [];
 }
\ No newline at end of file