t/deploy_methods/coderef-leakage.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use aliased 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator';
   9 use File::Temp;
  10
  11 use lib 't/lib';
  12
  13 use DBICDHTest;
  14
  15 my $dbh = DBICDHTest::dbh();
  16 my @connection = (sub { $dbh }, { ignore_version => 1 });
  17
  18 DBICDHTest::ready;
  19
  20 use_ok 'DBICVersion_v1';
  21 my $s = DBICVersion::Schema->connect(@connection);
  22 my $dm = Translator->new({ schema => $s });
  23
  24 my ($fname1, $fname2) = @_;
  25
  26 {
  27    my $fh = File::Temp->new(UNLINK => 0);
  28    print {$fh} 'sub leak {} sub { leak() }';
  29    $fname1 = $fh->filename;
  30    close $fh;
  31 }
  32
  33 {
  34    my $fh = File::Temp->new(UNLINK => 0);
  35    print {$fh} 'sub { leak() }';
  36    $fname2 = $fh->filename;
  37    close $fh;
  38 }
  39
  40 $dm->_run_perl($fname1, [1]);
  41 dies_ok { $dm->_run_perl($fname2, [1]) } 'info should not leak between coderefs';
  42
  43 done_testing;
  44
  45 END { unlink $fname1; unlink $fname2 }