t/storage/dbh_do.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use lib qw(t/lib);
   8 use DBICTest;
   9
  10
  11 my $schema = DBICTest->init_schema();
  12 my $storage = $schema->storage;
  13
  14 my @args;
  15 my $test_func = sub { @args = @_ };
  16
  17 $storage->dbh_do($test_func, "foo", "bar");
  18 is_deeply (
  19   \@args,
  20   [ $storage, $storage->dbh, "foo", "bar" ],
  21 );
  22
  23
  24 my $storage_class = ref $storage;
  25 {
  26   no strict 'refs';
  27   local *{$storage_class .'::__test_method'} = $test_func;
  28   $storage->dbh_do("__test_method", "baz", "buz");
  29 }
  30
  31 is_deeply (
  32   \@args,
  33   [ $storage, $storage->dbh, "baz", "buz" ],
  34 );
  35
  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
  42 done_testing;