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