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 'tempdir';
  10
  11 use lib 't/lib';
  12
  13 use DBICDHTest;
  14
  15 my $dbh = DBICDHTest::dbh();
  16 my $sql_dir = tempdir( CLEANUP => 1 );
  17 my @connection = (sub { $dbh }, { ignore_version => 1 });
  18
  19 use_ok 'DBICVersion_v1';
  20 my $s = DBICVersion::Schema->connect(@connection);
  21 my $dm = Translator->new({
  22    schema => $s,
  23    script_directory => $sql_dir,
  24 });
  25
  26 my ($fname1, $fname2) = @_;
  27
  28 {
  29    my $fh = File::Temp->new(UNLINK => 0);
  30    print {$fh} 'sub leak {} sub { leak() }';
  31    $fname1 = $fh->filename;
  32    close $fh;
  33 }
  34
  35 {
  36    my $fh = File::Temp->new(UNLINK => 0);
  37    print {$fh} 'sub { leak() }';
  38    $fname2 = $fh->filename;
  39    close $fh;
  40 }
  41
  42 $dm->_run_perl($fname1, [1]);
  43 dies_ok { $dm->_run_perl($fname2, [1]) } 'info should not leak between coderefs';
  44
  45 done_testing;
  46
  47 END { unlink $fname1; unlink $fname2 }