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 { |
7 | if( $ENV{PERL_CORE} ) { |
8 | chdir 't'; |
9 | @INC = ('../lib', 'lib/'); |
10 | } |
11 | else { |
12 | unshift @INC, 't/lib/'; |
13 | } |
14 | } |
15 | chdir 't'; |
16 | |
17 | use File::Spec; |
18 | |
5bdf71cc |
19 | use Test::More tests => 22; |
277189c8 |
20 | |
5bdf71cc |
21 | use Config; |
277189c8 |
22 | use TieOut; |
23 | use MakeMaker::Test::Utils; |
24 | use MakeMaker::Test::Setup::BFD; |
25 | |
26 | use ExtUtils::MakeMaker; |
27 | |
28 | chdir 't'; |
29 | |
30 | perl_lib(); |
31 | |
32 | ok( setup_recurs(), 'setup' ); |
33 | END { |
34 | ok( chdir File::Spec->updir ); |
35 | ok( teardown_recurs(), 'teardown' ); |
36 | } |
37 | |
38 | ok( 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 | |
5bdf71cc |
50 | |
51 | sub 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 | test_fixin(<<END, |
74 | #!/foo/bar/perl -w |
75 | |
76 | blah blah blah |
77 | END |
78 | sub { |
79 | my @lines = @_; |
80 | unlike $lines[0], qr[/foo/bar/perl], "#! replaced"; |
81 | like $lines[0], qr[ -w\b], "switch retained"; |
82 | |
83 | # In between might be that "not running under some shell" madness. |
84 | |
85 | is $lines[-1], "blah blah blah\n", "Program text retained"; |
86 | } |
87 | ); |
88 | |
89 | |
90 | # [rt.cpan.org 29442] |
91 | test_fixin(<<END, |
92 | #!/foo/bar/perl5.8.8 -w |
93 | |
94 | blah blah blah |
95 | END |
96 | |
97 | sub { |
98 | my @lines = @_; |
99 | unlike $lines[0], qr[/foo/bar/perl5.8.8], "#! replaced"; |
100 | like $lines[0], qr[ -w\b], "switch retained"; |
101 | |
102 | # In between might be that "not running under some shell" madness. |
103 | |
104 | is $lines[-1], "blah blah blah\n", "Program text retained"; |
105 | } |
106 | ); |
107 | |
108 | |
109 | # fixin shouldn't pick this up. |
110 | test_fixin(<<END, |
111 | #!/foo/bar/perly -w |
112 | |
113 | blah blah blah |
114 | END |
115 | |
116 | sub { |
117 | is join("", @_), <<END; |
118 | #!/foo/bar/perly -w |
119 | |
120 | blah blah blah |
121 | END |
122 | } |
123 | ); |