This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mktables: Calculate \p{Assigned} earlier in build
[perl5.git] / t / io / inplace.t
CommitLineData
fe14fcc3 1#!./perl
99ec4a7e 2use strict;
b5efbd1f 3chdir 't' if -d 't';
99ec4a7e 4require './test.pl';
8d063cd8 5
103a9d15 6$^I = $^O eq 'VMS' ? '_bak' : '.bak';
fe14fcc3 7
13290fcd 8plan( tests => 6 );
8d063cd8 9
62a28c97
NC
10my @tfiles = (tempfile(), tempfile(), tempfile());
11my @tfiles_bak = map "$_$^I", @tfiles;
99ec4a7e 12
62a28c97 13END { unlink_all(@tfiles_bak); }
99ec4a7e
CB
14
15for my $file (@tfiles) {
16 runperl( prog => 'print qq(foo\n);',
17 args => ['>', $file] );
68dc0745 18}
99ec4a7e
CB
19
20@ARGV = @tfiles;
21
8d063cd8
LW
22while (<>) {
23 s/foo/bar/;
24}
25continue {
26 print;
27}
28
99ec4a7e
CB
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" );
8d063cd8 36
13290fcd
TC
37SKIP:
38{
739a0b84 39 # based on code, dosish systems can't do no-backup inplace
13290fcd 40 # edits
739a0b84 41 $^O =~ /^(MSWin32|cygwin|uwin|dos|os2)$/
13290fcd
TC
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
15fe4dea
CB
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 ),
13290fcd
TC
66 "foobar\nfoobar\nfoobar\n",
67 "normal inplace edit");
68 }
69
93f09d7b 70 # test * equivalence RT #70802
13290fcd
TC
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
15fe4dea
CB
86 my @my_ifiles = @ifiles;
87 is( runperl( prog => 'print<>;', args => \@my_ifiles ),
13290fcd
TC
88 "foobar\nfoobar\nfoobar\n",
89 "normal inplace edit");
90 }
91
92 END { unlink_all(@ifiles); }
93}