Preserve @_ aliasing semantics on coderefs within try{} blocks

diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index bec0133..7b7fa60 100644 (file)
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -187,7 +187,8 @@ transaction failure.
 =cut
 
 sub txn_do {
-  my ($self, $coderef, @args) = @_;
+  my $self = shift;
+  my $coderef = shift;
 
   ref $coderef eq 'CODE' or $self->throw_exception
     ('$coderef must be a CODE reference');
@@ -199,19 +200,21 @@ sub txn_do {
   my $wantarray = wantarray; # Need to save this since the context
                              # inside the try{} block is independent
                              # of the context that called txn_do()
+  my $args = \@_;
+
   try {
 
     # Need to differentiate between scalar/list context to allow for
     # returning a list in scalar context to get the size of the list
     if ($wantarray) {
       # list context
-      @return_values = $coderef->(@args);
+      @return_values = $coderef->(@$args);
     } elsif (defined $wantarray) {
       # scalar context
-      $return_value = $coderef->(@args);
+      $return_value = $coderef->(@$args);
     } else {
       # void context
-      $coderef->(@args);
+      $coderef->(@$args);
     }
     $self->txn_commit;
   }

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 1630180..1eec464 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -732,9 +732,10 @@ sub dbh_do {
 
   local $self->{_in_dbh_do} = 1;
 
-  my @args = @_;
+  # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
+  my $args = \@_;
   return try {
-    $self->$code ($dbh, @args);
+    $self->$code ($dbh, @$args);
   } catch {
     $self->throw_exception($_) if $self->connected;
 
@@ -744,7 +745,7 @@ sub dbh_do {
       if $ENV{DBIC_DBIRETRY_DEBUG};
 
     $self->_populate_dbh;
-    $self->$code($self->_dbh, @args);
+    $self->$code($self->_dbh, @$args);
   };
 }
 
@@ -768,19 +769,22 @@ sub txn_do {
   my $tried = 0;
   while(1) {
     my $exception;
-    my @args = @_;
+
+    # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
+    my $args = \@_;
+
     try {
       $self->_get_dbh;
 
       $self->txn_begin;
       if($want_array) {
-          @result = $coderef->(@args);
+          @result = $coderef->(@$args);
       }
       elsif(defined $want_array) {
-          $result[0] = $coderef->(@args);
+          $result[0] = $coderef->(@$args);
       }
       else {
-          $coderef->(@args);
+          $coderef->(@$args);
       }
       $self->txn_commit;
     } catch {

diff --git a/t/storage/dbh_do.t b/t/storage/dbh_do.t
index a5a58d6..eb8bd20 100644 (file)
--- a/t/storage/dbh_do.t
+++ b/t/storage/dbh_do.t
@@ -33,4 +33,10 @@ is_deeply (
   [ $storage, $storage->dbh, "baz", "buz" ],
 );
 
+# test aliasing
+my $res = 'original';
+$storage->dbh_do (sub { $_[2] = 'changed' }, $res);
+
+is ($res, 'changed', "Arguments properly aliased for dbh_do");
+
 done_testing;

diff --git a/t/81transactions.t b/t/storage/txn.t
similarity index 97%
rename from t/81transactions.t
rename to t/storage/txn.t
index a13c651..4fe7772 100644 (file)
--- a/t/81transactions.t
+++ b/t/storage/txn.t
@@ -63,6 +63,13 @@ my $code = sub {
   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
 }
 
+# Test txn_do() @_ aliasing support
+{
+  my $res = 'original';
+  $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
+  is ($res, 'changed', "Arguments properly aliased for txn_do");
+}
+
 # Test nested successful txn_do()
 {
   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
@@ -233,6 +240,7 @@ $schema->storage->disconnect;
 
   is($schema->storage->transaction_depth, 0, "Correct transaction depth");
   my $artist_rs = $schema->resultset('Artist');
+  my $fn = __FILE__;
   throws_ok {
    my $guard = $schema->txn_scope_guard;
 
@@ -243,7 +251,7 @@ $schema->storage->disconnect;
     });
 
    $guard->commit;
-  } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/s, "Error propogated okay";
+  } qr/No such column made_up_column .*? at .*?$fn line \d+/s, "Error propogated okay";
 
   ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");