lib/ExtUtils/t/fixin.t

   1 #!/usr/bin/perl -w
   2
   3 # Try to test fixin.  I say "try" because what fixin will actually do
   4 # is highly variable from system to system.
   5
   6 BEGIN {
   7     if( $ENV{PERL_CORE} ) {
   8         chdir 't';
   9         @INC = ('../lib', 'lib/');
  10     }
  11     else {
  12         unshift @INC, 't/lib/';
  13     }
  14 }
  15 chdir 't';
  16
  17 use File::Spec;
  18
  19 use Test::More tests => 22;
  20
  21 use Config;
  22 use TieOut;
  23 use MakeMaker::Test::Utils;
  24 use MakeMaker::Test::Setup::BFD;
  25
  26 use ExtUtils::MakeMaker;
  27
  28 chdir 't';
  29
  30 perl_lib();
  31
  32 ok( setup_recurs(), 'setup' );
  33 END {
  34     ok( chdir File::Spec->updir );
  35     ok( teardown_recurs(), 'teardown' );
  36 }
  37
  38 ok( chdir 'Big-Dummy', "chdir'd to Big-Dummy" ) ||
  39   diag("chdir failed: $!");
  40
  41 # [rt.cpan.org 26234]
  42 {
  43     local $/ = "foo";
  44     local $\ = "bar";
  45     MY->fixin("bin/program");
  46     is $/, "foo", '$/ not clobbered';
  47     is $\, "bar", '$\ not clobbered';
  48 }
  49
  50
  51 sub test_fixin {
  52     my($code, $test) = @_;
  53
  54     my $file = "fixin_test";
  55     ok(open(my $fh, ">", $file), "write $file") or diag "Can't write $file: $!";
  56     print $fh $code;
  57     close $fh;
  58
  59     MY->fixin($file);
  60
  61     ok(open($fh, "<", $file), "read $file") or diag "Can't read $file: $!";
  62     my @lines = <$fh>;
  63     close $fh;
  64
  65     $test->(@lines);
  66
  67     1 while unlink $file;
  68     ok !-e $file, "cleaned up $file";
  69 }
  70
  71
  72 # A simple test of fixin
  73 test_fixin(<<END,
  74 #!/foo/bar/perl -w
  75
  76 blah blah blah
  77 END
  78     sub {
  79         my @lines = @_;
  80         unlike $lines[0], qr[/foo/bar/perl], "#! replaced";
  81         like   $lines[0], qr[ -w\b], "switch retained";
  82
  83         # In between might be that "not running under some shell" madness.
  84
  85         is $lines[-1], "blah blah blah\n", "Program text retained";
  86     }
  87 );
  88
  89
  90 # [rt.cpan.org 29442]
  91 test_fixin(<<END,
  92 #!/foo/bar/perl5.8.8 -w
  93
  94 blah blah blah
  95 END
  96
  97     sub {
  98         my @lines = @_;
  99         unlike $lines[0], qr[/foo/bar/perl5.8.8], "#! replaced";
 100         like   $lines[0], qr[ -w\b], "switch retained";
 101
 102         # In between might be that "not running under some shell" madness.
 103
 104         is $lines[-1], "blah blah blah\n", "Program text retained";
 105     }
 106 );
 107
 108
 109 # fixin shouldn't pick this up.
 110 test_fixin(<<END,
 111 #!/foo/bar/perly -w
 112
 113 blah blah blah
 114 END
 115
 116     sub {
 117         is join("", @_), <<END;
 118 #!/foo/bar/perly -w
 119
 120 blah blah blah
 121 END
 122     }
 123 );