xref: /openbsd-src/gnu/usr.bin/perl/cpan/ExtUtils-MakeMaker/t/fixin.t (revision 256a93a44f36679bee503f12e49566c2183f6181) 
1#!/usr/bin/perl -w
2
3use strict;
4use warnings;
5
6# Try to test fixin.  I say "try" because what fixin will actually do
7# is highly variable from system to system.
8
9BEGIN {
10    unshift @INC, 't/lib/';
11}
12
13use File::Spec;
14
15use Test::More tests => 30;
16
17use Config;
18use TieOut;
19use MakeMaker::Test::Utils;
20use MakeMaker::Test::Setup::BFD;
21
22use ExtUtils::MakeMaker;
23
24chdir 't';
25perl_lib; # sets $ENV{PERL5LIB} relative to t/
26
27use File::Temp qw[tempdir];
28my $tmpdir = tempdir( DIR => '../t', CLEANUP => 1 );
29use Cwd; my $cwd = getcwd; END { chdir $cwd } # so File::Temp can cleanup
30chdir $tmpdir;
31
32ok( setup_recurs(), 'setup' );
33END {
34    ok( chdir File::Spec->updir );
35    ok( teardown_recurs(), 'teardown' );
36}
37
38ok( 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
51sub 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# On VMS, the shebang line comes after the startperl business.
74my $shb_line_num = $^O eq 'VMS' ? 2 : 0;
75test_fixin(<<END,
76#!/foo/bar/perl -w
77
78blah blah blah
79END
80    sub {
81        my @lines = @_;
82        unlike $lines[$shb_line_num], qr[/foo/bar/perl], "#! replaced";
83        like   $lines[$shb_line_num], qr[ -w\b], "switch retained";
84
85        # In between might be that "not running under some shell" madness.
86
87        is $lines[-1], "blah blah blah\n", "Program text retained";
88    }
89);
90
91
92# [rt.cpan.org 29442]
93test_fixin(<<END,
94#!/foo/bar/perl5.8.8 -w
95
96blah blah blah
97END
98
99    sub {
100        my @lines = @_;
101        unlike $lines[$shb_line_num], qr[/foo/bar/perl5.8.8], "#! replaced";
102        like   $lines[$shb_line_num], qr[ -w\b], "switch retained";
103
104        # In between might be that "not running under some shell" madness.
105
106        is $lines[-1], "blah blah blah\n", "Program text retained";
107    }
108);
109
110
111# fixin shouldn't pick this up.
112SKIP: {
113    skip "Not relevant on VMS", 4 if $^O eq 'VMS';
114    test_fixin(<<END,
115#!/foo/bar/perly -w
116
117blah blah blah
118END
119
120        sub {
121            is join("", @_), <<END;
122#!/foo/bar/perly -w
123
124blah blah blah
125END
126        }
127    );
128}
129
130SKIP: {
131    eval { chmod(0755, "usrbin/interp") }
132        or skip "no chmod", 8;
133    skip "Not relevant on VMS or MSWin32", 8 if $^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'cygwin';
134
135    my $dir = getcwd();
136    local $ENV{PATH} = join $Config{path_sep}, map "$dir/$_", qw(usrbin bin);
137
138    test_fixin(<<END,
139#!$dir/bin/interp
140
141blah blah blah
142END
143         sub {
144             is $_[0], "#!$dir/usrbin/interp\n", 'interpreter updated to one found in PATH';
145         }
146     );
147
148    eval { symlink("../usrbin/interp", "bin/interp") }
149        or skip "no symlinks", 4;
150
151    test_fixin(<<END,
152#!$dir/bin/interp
153
154blah blah blah
155END
156         sub {
157             is $_[0], "#!$dir/bin/interp\n", 'symlinked interpreter later in PATH not mangled';
158         }
159     );
160}
161