t/io/inplace.t

   1 #!./perl
   2 use strict;
   3 chdir 't' if -d 't';
   4 require './test.pl';
   5
   6 $^I = $^O eq 'VMS' ? '_bak' : '.bak';
   7
   8 plan( tests => 6 );
   9
  10 my @tfiles     = (tempfile(), tempfile(), tempfile());
  11 my @tfiles_bak = map "$_$^I", @tfiles;
  12
  13 END { unlink_all(@tfiles_bak); }
  14
  15 for my $file (@tfiles) {
  16     runperl( prog => 'print qq(foo\n);',
  17              args => ['>', $file] );
  18 }
  19
  20 @ARGV = @tfiles;
  21
  22 while (<>) {
  23     s/foo/bar/;
  24 }
  25 continue {
  26     print;
  27 }
  28
  29 is ( runperl( prog => 'print<>;', args => \@tfiles ),
  30      "bar\nbar\nbar\n",
  31      "file contents properly replaced" );
  32
  33 is ( runperl( prog => 'print<>;', args => \@tfiles_bak ),
  34      "foo\nfoo\nfoo\n",
  35      "backup file contents stay the same" );
  36
  37 SKIP:
  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 }