Commit | Line | Data |
277189c8 |
1 | #!/usr/bin/perl -w |
2 | |
5bdf71cc |
3 | # Try to test fixin. I say "try" because what fixin will actually do |
4 | # is highly variable from system to system. |
5 | |
277189c8 |
6 | BEGIN { |
b78fd716 |
7 | unshift @INC, 't/lib/'; |
277189c8 |
8 | } |
9 | chdir 't'; |
10 | |
11 | use File::Spec; |
12 | |
5bdf71cc |
13 | use Test::More tests => 22; |
277189c8 |
14 | |
5bdf71cc |
15 | use Config; |
277189c8 |
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 | |
5bdf71cc |
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 | ); |