X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Fargv.t;h=d6c895d6cc9fa806ebfc61a1d9934b9cab7c5734;hb=7de9d14ea5825e7555ec8154a1b3731aa00948b6;hp=3840f657f149afec99c9cc9fa28dfd838463dbd4;hpb=7d932aad28c4908d05dbf4a2f3482f7c2445c3bf;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/io/argv.t b/t/io/argv.t
old mode 100755
new mode 100644
index 3840f65..d6c895d
--- a/t/io/argv.t
+++ b/t/io/argv.t
@@ -5,35 +5,9 @@ BEGIN {
     @INC = '../lib';
 }
 
-sub runthis {
-    my($prog, $stdin, @files) = @_;
-
-    my $cmd = '';
-    if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' ) {
-        $cmd = qq{$^X -e "$prog"};
-        $cmd .= " ". join ' ', map qq{"$_"}, @files if @files;
-        $cmd = qq{$^X -le "print '$stdin'" | } . $cmd if defined $stdin;
-    }
-    else {
-        $cmd = qq{$^X -e '$prog' @files};
-        $cmd = qq{$^X -le 'print q{$stdin}' | } . $cmd if defined $stdin;
-    }
+BEGIN { require "./test.pl"; }
 
-    # The combination of $^X, pipes and STDIN is broken on VMS and
-    # will hang.
-    if( defined $stdin && $^O eq 'VMS' && $TODO ) {
-        return 0;
-    }
-
-    my $result = `$cmd`;
-    $result =~ s/\n\n/\n/ if $^O eq 'VMS'; # pipes sometimes double these
-
-    return $result;
-}
-
-    
-require "./test.pl";
-plan(tests => 21);
+plan(tests => 23);
 
 use File::Spec;
 
@@ -41,21 +15,36 @@ my $devnull = File::Spec->devnull;
 
 open(TRY, '>Io_argv1.tmp') || (die "Can't open temp file: $!");
 print TRY "a line\n";
-close TRY;
+close TRY or die "Could not close: $!";
 
-$x = runthis( 'while (<>) { print $., $_; }', undef, ('Io_argv1.tmp') x 2);
+$x = runperl(
+    prog	=> 'while (<>) { print $., $_; }',
+    args	=> [ 'Io_argv1.tmp', 'Io_argv1.tmp' ],
+);
 is($x, "1a line\n2a line\n", '<> from two files');
 
 {
-    local $TODO = 'The combo of STDIN, pipes and $^X is broken on VMS'
-      if $^O eq 'VMS';
-    $x = runthis( 'while (<>) { print $_; }', 'foo', 'Io_argv1.tmp', '-' );
+    $x = runperl(
+	prog	=> 'while (<>) { print $_; }',
+	stdin	=> "foo\n",
+	args	=> [ 'Io_argv1.tmp', '-' ],
+    );
     is($x, "a line\nfoo\n", '   from a file and STDIN');
 
-    $x = runthis( 'while (<>) {print $_;}', 'foo' );
+    $x = runperl(
+	prog	=> 'while (<>) { print $_; }',
+	stdin	=> "foo\n",
+    );
     is($x, "foo\n", '   from just STDIN');
 }
 
+{
+    # 5.10 stopped autovivifying scalars in globs leading to a
+    # segfault when $ARGV is written to.
+    runperl( prog => 'eof()', stdin => "nothing\n" );
+    is( 0+$?, 0, q(eof() doesn't segfault) );
+}
+
 @ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp');
 while (<>) {
     $y .= $. . $_;
@@ -68,13 +57,13 @@ is($y, "1a line\n2a line\n3a line\n", '<> from @ARGV');
 
 
 open(TRY, '>Io_argv1.tmp') or die "Can't open temp file: $!";
-close TRY;
+close TRY or die "Could not close: $!";
 open(TRY, '>Io_argv2.tmp') or die "Can't open temp file: $!";
-close TRY;
+close TRY or die "Could not close: $!";
 @ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp');
 $^I = '_bak';   # not .bak which confuses VMS
 $/ = undef;
-my $i = 6;
+my $i = 7;
 while (<>) {
     s/^/ok $i\n/;
     ++$i;
@@ -85,18 +74,21 @@ open(TRY, '<Io_argv1.tmp') or die "Can't open temp file: $!";
 print while <TRY>;
 open(TRY, '<Io_argv2.tmp') or die "Can't open temp file: $!";
 print while <TRY>;
-close TRY;
+close TRY or die "Could not close: $!";
 undef $^I;
 
 ok( eof TRY );
 
-ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
+{
+    no warnings 'once';
+    ok( eof NEVEROPENED,    'eof() true on unopened filehandle' );
+}
 
 open STDIN, 'Io_argv1.tmp' or die $!;
 @ARGV = ();
 ok( !eof(),     'STDIN has something' );
 
-is( <>, "ok 6\n" );
+is( <>, "ok 7\n" );
 
 open STDIN, $devnull or die $!;
 @ARGV = ();
@@ -113,7 +105,7 @@ ok( eof(),      'eof() true after closing ARGV' );
 
 {
     local $/;
-    open F, 'Io_argv1.tmp' or die;
+    open F, 'Io_argv1.tmp' or die "Could not open Io_argv1.tmp: $!";
     <F>;	# set $. = 1
     is( <F>, undef );
 
@@ -126,7 +118,25 @@ ok( eof(),      'eof() true after closing ARGV' );
     open F, $devnull or die;	# restart cycle again
     ok( defined(<F>) );
     is( <F>, undef );
-    close F;
+    close F or die "Could not close: $!";
+}
+
+# This used to dump core
+fresh_perl_is( <<'**PROG**', "foobar", {}, "ARGV aliasing and eof()" ); 
+open OUT, ">Io_argv3.tmp" or die "Can't open temp file: $!";
+print OUT "foo";
+close OUT;
+open IN, "Io_argv3.tmp" or die "Can't open temp file: $!";
+*ARGV = *IN;
+while (<>) {
+    print;
+    print "bar" if eof();
 }
+close IN;
+unlink "Io_argv3.tmp";
+**PROG**
 
-END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp.bak', 'Io_argv2.tmp', 'Io_argv2.tmp.bak' }
+END {
+    1 while unlink 'Io_argv1.tmp', 'Io_argv1.tmp_bak',
+	'Io_argv2.tmp', 'Io_argv2.tmp_bak', 'Io_argv3.tmp';
+}