t/io/inplace.t

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