X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstorage%2Fdbh_do.t;h=82e33d81920e992b43ffeeaffd9ff6e00b9c79d0;hb=64ae166780d0cb2b9577e506da9b9b240c146d20;hp=23fd85931ad8f1f74b865491106778fc9c35e1de;hpb=2dc8d9618fd296ecdd4484d3686832de0592e747;p=dbsrgits%2FDBIx-Class.git diff --git a/t/storage/dbh_do.t b/t/storage/dbh_do.t index 23fd859..82e33d8 100644 --- a/t/storage/dbh_do.t +++ b/t/storage/dbh_do.t @@ -1,9 +1,7 @@ -#!/usr/bin/perl - use strict; -use warnings; +use warnings; -use Test::More tests => 8; +use Test::More; use lib qw(t/lib); use DBICTest; @@ -11,23 +9,32 @@ use DBICTest; my $schema = DBICTest->init_schema(); my $storage = $schema->storage; -my $test_func = sub { - is $_[0], $storage; - is $_[1], $storage->dbh; - is $_[2], "foo"; - is $_[3], "bar"; -}; +my @args; +my $test_func = sub { @args = @_ }; -$storage->dbh_do( - $test_func, - "foo", "bar" +$storage->dbh_do($test_func, "foo", "bar"); +is_deeply ( + \@args, + [ $storage, $storage->dbh, "foo", "bar" ], ); + my $storage_class = ref $storage; { - no strict 'refs'; - *{$storage_class .'::__test_method'} = $test_func; + no strict 'refs'; + local *{$storage_class .'::__test_method'} = $test_func; + $storage->dbh_do("__test_method", "baz", "buz"); } -$storage->dbh_do("__test_method", "foo", "bar"); - \ No newline at end of file +is_deeply ( + \@args, + [ $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;