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
6BEGIN {
7    unshift @INC, 't/lib/';
8}
9chdir 't';
10
11use File::Spec;
12
13use Test::More tests => 22;
14
15use Config;
16use TieOut;
17use MakeMaker::Test::Utils;
18use MakeMaker::Test::Setup::BFD;
19
20use ExtUtils::MakeMaker;
21
22chdir 't';
23
24perl_lib();
25
26ok( setup_recurs(), 'setup' );
27END {
28    ok( chdir File::Spec->updir );
29    ok( teardown_recurs(), 'teardown' );
30}
31
32ok( 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
45sub 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
67test_fixin(<<END,
68#!/foo/bar/perl -w
69
70blah blah blah
71END
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]
85test_fixin(<<END,
86#!/foo/bar/perl5.8.8 -w
87
88blah blah blah
89END
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.
104test_fixin(<<END,
105#!/foo/bar/perly -w
106
107blah blah blah
108END
109
110    sub {
111        is join("", @_), <<END;
112#!/foo/bar/perly -w
113
114blah blah blah
115END
116    }
117);
118