Commit | Line | Data |
3ff1602f |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
492bb85a |
4 | use warnings; |
3ff1602f |
5 | |
492bb85a |
6 | use Test::More; |
3ff1602f |
7 | use lib qw(t/lib); |
8 | use DBICTest; |
9 | |
10 | |
11 | my $schema = DBICTest->init_schema(); |
12 | my $storage = $schema->storage; |
13 | |
492bb85a |
14 | my @args; |
15 | my $test_func = sub { @args = @_ }; |
3ff1602f |
16 | |
492bb85a |
17 | $storage->dbh_do($test_func, "foo", "bar"); |
18 | is_deeply ( |
19 | \@args, |
20 | [ $storage, $storage->dbh, "foo", "bar" ], |
3ff1602f |
21 | ); |
22 | |
492bb85a |
23 | |
3ff1602f |
24 | my $storage_class = ref $storage; |
25 | { |
492bb85a |
26 | no strict 'refs'; |
27 | local *{$storage_class .'::__test_method'} = $test_func; |
28 | $storage->dbh_do("__test_method", "baz", "buz"); |
3ff1602f |
29 | } |
3ff1602f |
30 | |
492bb85a |
31 | is_deeply ( |
32 | \@args, |
33 | [ $storage, $storage->dbh, "baz", "buz" ], |
34 | ); |
35 | |
38ed54cd |
36 | # test aliasing |
37 | my $res = 'original'; |
38 | $storage->dbh_do (sub { $_[2] = 'changed' }, $res); |
39 | |
40 | is ($res, 'changed', "Arguments properly aliased for dbh_do"); |
41 | |
492bb85a |
42 | done_testing; |