1#!./perl 2use strict; 3chdir 't' if -d 't'; 4require './test.pl'; 5 6$^I = $^O eq 'VMS' ? '_bak' : '.bak'; 7 8plan( tests => 8 ); 9 10my @tfiles = (tempfile(), tempfile(), tempfile()); 11my @tfiles_bak = map "$_$^I", @tfiles; 12 13END { unlink_all(@tfiles_bak); } 14 15for my $file (@tfiles) { 16 runperl( prog => 'print qq(foo\n);', 17 args => ['>', $file] ); 18} 19 20@ARGV = @tfiles; 21 22while (<>) { 23 s/foo/bar/; 24} 25continue { 26 print; 27} 28 29is ( runperl( prog => 'print<>;', args => \@tfiles ), 30 "bar\nbar\nbar\n", 31 "file contents properly replaced" ); 32 33is ( runperl( prog => 'print<>;', args => \@tfiles_bak ), 34 "foo\nfoo\nfoo\n", 35 "backup file contents stay the same" ); 36 37SKIP: 38{ 39 # based on code, dosish systems can't do no-backup inplace 40 # edits 41 $^O =~ /^(MSWin32|cygwin|uwin|dos|os2)$/ 42 and skip("Can't inplace edit without backups on $^O", 4); 43 44 our @ifiles = ( tempfile(), tempfile(), tempfile() ); 45 46 { 47 for my $file (@ifiles) { 48 runperl( prog => 'print qq(bar\n);', 49 args => [ '>', $file ] ); 50 } 51 52 local $^I = ''; 53 local @ARGV = @ifiles; 54 55 while (<>) { 56 print "foo$_"; 57 } 58 59 is(scalar(@ARGV), 0, "consumed ARGV"); 60 61# runperl may quote its arguments, so don't expect to be able 62# to reuse things you send it. 63 64 my @my_ifiles = @ifiles; 65 is( runperl( prog => 'print<>;', args => \@my_ifiles ), 66 "foobar\nfoobar\nfoobar\n", 67 "normal inplace edit"); 68 } 69 70 # test * equivalence RT #70802 71 { 72 for my $file (@ifiles) { 73 runperl( prog => 'print qq(bar\n);', 74 args => [ '>', $file ] ); 75 } 76 77 local $^I = '*'; 78 local @ARGV = @ifiles; 79 80 while (<>) { 81 print "foo$_"; 82 } 83 84 is(scalar(@ARGV), 0, "consumed ARGV"); 85 86 my @my_ifiles = @ifiles; 87 is( runperl( prog => 'print<>;', args => \@my_ifiles ), 88 "foobar\nfoobar\nfoobar\n", 89 "normal inplace edit"); 90 } 91 92 END { unlink_all(@ifiles); } 93} 94 95{ 96 my @tests = 97 ( # opts, code, result, name, $TODO 98 [ "-n", "die", "bar\n", "die shouldn't touch file" ], 99 [ "-n", "last", "", "last should update file" ], 100 ); 101 our $file = tempfile() ; 102 103 for my $test (@tests) { 104 (my ($opts, $code, $result, $name), our $TODO) = @$test; 105 open my $fh, ">", $file or die; 106 print $fh "bar\n"; 107 close $fh; 108 109 runperl( prog => $code, 110 switches => [ grep length, "-i", $opts ], 111 args => [ $file ], 112 stderr => 1, # discarded 113 ); 114 open $fh, "<", $file or die; 115 my $data = do { local $/; <$fh>; }; 116 close $fh; 117 is($data, $result, $name); 118 } 119} 120