t/30-run_perl.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use VPIT::TestHelpers 'run_perl' => [ 'VTH' ];
   7
   8 use Test::More tests => 5 + 2;
   9
  10 use Config;
  11 use File::Temp;
  12
  13 my $filename = '/tmp/run_perl_test';
  14
  15 my $guard = VPIT::TestHelpers::Guard->new(sub { unlink $filename });
  16
  17 my $code = "open my \$fh, q[>], q[$filename] or die \$!; for my \$key (sort keys %ENV) { print \$fh qq[\$key:\$ENV{\$key}\n] } close \$fh";
  18
  19 my $ld_path = $Config::Config{ldlibpthname};
  20
  21 my %expected_vars = (
  22  'MSWin32' => [ qw<SystemRoot> ],
  23  'android' => [                ],
  24  'cygwin'  => [ qw<PATH>       ],
  25  'darwin'  => [                ],
  26  'linux'   => [                ],
  27 );
  28 unless ($^O eq 'darwin') {
  29  push @$_, $ld_path for values %expected_vars;
  30 }
  31
  32 my @all_vars = do {
  33  my %uniq;
  34  grep !$uniq{$_}++, map @$_, values %expected_vars;
  35 };
  36 push @all_vars, 'DUMMY';
  37
  38 my @ignored_vars = qw<
  39  VERSIONER_PERL_PREFER_32_BIT
  40  VERSIONER_PERL_VERSION
  41  __CF_USER_TEXT_ENCODING
  42 >;
  43 push @ignored_vars, $ld_path if $^O eq 'darwin';
  44
  45 for my $os (qw<MSWin32 android darwin cygwin linux>) {
  46  1 while unlink $filename;
  47
  48  local %ENV;
  49  @ENV{@all_vars} = @all_vars;
  50
  51  {
  52   local $^O = $os;
  53   run_perl $code;
  54  }
  55
  56  my %subprocess_env;
  57
  58  open my $fh, '<', $filename;
  59  if ($fh) {
  60   my @lines = <$fh>;
  61   close $fh;
  62   chomp for @lines;
  63   %subprocess_env = map { split /:/, $_, 2 } @lines;
  64  }
  65
  66  delete @subprocess_env{@ignored_vars};
  67
  68  my $got = join "\n", sort keys %subprocess_env;
  69  my $exp = join "\n", sort @{ $expected_vars{$os} || [] };
  70
  71  is $got, $exp, "run_perl preserving $os ENV vars";
  72 }
  73
  74 {
  75  local $@;
  76  eval {
  77   run_perl 'print "hello\n"';
  78  };
  79  like $@, qr/^Double quotes in evaluated code are not portable/,
  80           'croak on double quotes';
  81 }
  82
  83 {
  84  my $msg = VTH_RUN_PERL_FAILED;
  85  like $msg, qr/^Could not execute/, 'RUN_PERL_FAILED error message';
  86 }