xref: /openbsd/gnu/usr.bin/perl/t/io/inplace.t (revision b46d8ef2) 
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
37our @ifiles = ( tempfile(), tempfile(), tempfile() );
38
39{
40    for my $file (@ifiles) {
41        runperl( prog => 'print qq(bar\n);',
42                 args => [ '>', $file ] );
43    }
44
45    local $^I = '';
46    local @ARGV = @ifiles;
47
48    while (<>) {
49        print "foo$_";
50    }
51
52    is(scalar(@ARGV), 0, "consumed ARGV");
53
54    # runperl may quote its arguments, so don't expect to be able
55    # to reuse things you send it.
56
57    my @my_ifiles = @ifiles;
58    is( runperl( prog => 'print<>;', args => \@my_ifiles ),
59        "foobar\nfoobar\nfoobar\n",
60        "normal inplace edit");
61}
62
63# test * equivalence RT #70802
64{
65    for my $file (@ifiles) {
66        runperl( prog => 'print qq(bar\n);',
67        args => [ '>', $file ] );
68    }
69
70    local $^I = '*';
71    local @ARGV = @ifiles;
72
73    while (<>) {
74        print "foo$_";
75    }
76
77    is(scalar(@ARGV), 0, "consumed ARGV");
78
79    my @my_ifiles = @ifiles;
80    is( runperl( prog => 'print<>;', args => \@my_ifiles ),
81        "foobar\nfoobar\nfoobar\n",
82        "normal inplace edit");
83}
84
85END { unlink_all(@ifiles); }
86
87{
88    my @tests =
89      ( # opts, code, result, name, $TODO
90       [ "-n", "die", "bar\n", "die shouldn't touch file" ],
91       [ "-n", "last", "", "last should update file" ],
92      );
93    our $file = tempfile() ;
94
95    for my $test (@tests) {
96        (my ($opts, $code, $result, $name), our $TODO) = @$test;
97        open my $fh, ">", $file or die;
98        print $fh "bar\n";
99        close $fh;
100
101        runperl( prog => $code,
102                 switches => [ grep length, "-i", $opts ],
103                 args => [ $file ],
104                 stderr => 1, # discarded
105               );
106        open $fh, "<", $file or die;
107        my $data = do { local $/; <$fh>; };
108        close $fh;
109        is($data, $result, $name);
110    }
111}
112