The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test2::Bundle::Extended;
use Test::Script;
use File::Spec;
use File::Temp qw( tempdir );

# the first subtest replaces t/02_compiles_good.t

subtest 'good' => sub {

  my $rv;
  is(
    intercept { $rv = script_compiles 't/bin/good.pl' },
    array {
      event Ok => sub {
        call pass => T();
        call name => 'Script t/bin/good.pl compiles';
      };
      end;
    },
    'script_compiles t/bin/good.pl',
  );

  is $rv, T(), 'script_compiles_ok returns true as convenience';

  is(
    intercept { $rv = script_compiles 't/bin/good.pl', 'It worked' },
    array {
      event Ok => sub {
        call pass => T();
        call name => 'It worked';
      };
      end;
    },
    'script_compiles t/bin/good.pl It worked',
  );
  
  is $rv, T(), 'script_compiles_ok returns true as convenience';
};

# second subtest replaces t/03_compiles_bad.t

subtest 'bad' => sub {

  my $rv;
  my $bad = File::Spec->catfile(qw( t bin bad.pl ));
  ok -f $bad, 'found bad script';

  is(
    intercept { $rv = script_compiles 't/bin/bad.pl' },
    array {
      event Ok => sub {
        call pass => F();
        call name => 'Script t/bin/bad.pl compiles';
      };
      event Diag => sub {
        # generated by TB / T2
      };
      event Diag => sub {
        # generated by TB / T2
      };
      event Diag => sub {
        call message => match qr{\d+ - (?:Using.*\n# )?Bad at \Q$bad\E line 4\.\n};
        call message => match qr{BEGIN failed--compilation aborted at \Q$bad\E line 5.};
      };
      end;
    },
    'script_compiles t/bin/bad.pl',
  );

  is $rv, F(), 'script_compiles_ok returns false as convenience';

  is(
    intercept { $rv = script_compiles 't/bin/bad.pl', 'It worked' },
    array {
      event Ok => sub {
        call pass => F();
        call name => 'It worked';
      };
      event Diag => sub {
        # generated by TB / T2
      };
      event Diag => sub {
        # generated by TB / T2
      };
      event Diag => sub {
        call message => match qr{\d+ - (?:Using.*\n# )?Bad at \Q$bad\E line 4\.\n};
        call message => match qr{BEGIN failed--compilation aborted at \Q$bad\E line 5\.};
      };
      end;
    },
    'script_compiles t/bin/bad.pl It worked',
  );

  is $rv, F(), 'script_compiles_ok returns false as convenience';

};

subtest 'unreasonable number of libs' => sub {

  skip_all 'developer only test' unless $ENV{TEST_SCRIPT_DEV_TEST};
  
  local @INC = @INC;
  
  my $dir = tempdir( CLEANUP => 1 );
  
  for(map { File::Spec->catfile($dir, $_) } 1..1000000)
  {
    #mkdir;
    push @INC, $_;
  }
  
  script_compiles 't/bin/good.pl';

};

done_testing;