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