Make stacked -l work

Perl 5.10.0 introduced stacked filetest operators,

   -x -r $foo

being equivalent to

    -r $foo && -x _

That does not work with -l.  It was these suspicious lines in
Perl_my_lstat_flags that drew my attention to it:

>     else if (PL_laststype != OP_LSTAT
> 	    && (PL_op->op_private & OPpFT_STACKED) && ckWARN(WARN_IO))
> 	Perl_croak(aTHX_ no_prev_lstat);

That croak only happens when warnings are on.  Warnings are just
supposed to be warnings, unless the ‘user’ explicitly requests
fatal warnings.

$ perl -le 'print "foo", -l -e "miniperl"'
foo
$ perl -lwe 'print "foo", -l -e "miniperl"'
The stat preceding -l _ wasn't an lstat at -e line 1.

That it doesn’t die in the first example is a bug.

In fact, it’s using the return value of -e as a file name:

$ ln -s miniperl 1
$ ./miniperl -le 'print -l -e "miniperl"'
1

And, with warnings on, if the preceding stat *was* an lstat, it
falls back to the pre-stacked behaviour, just as it does when warn-
ings are off.

It’s meant to be equivalent to -e "miniperl" && -l _ (which is why the
error message above says ‘The stat preceding -l _’).

diff --git a/doio.c b/doio.c
index 838786e..f03db27 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1342,9 +1342,11 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
        }
        return (PL_laststatval = -1);
     }
        }
        return (PL_laststatval = -1);
     }

-    else if (PL_laststype != OP_LSTAT
-           && (PL_op->op_private & OPpFT_STACKED) && ckWARN(WARN_IO))
+    else if (PL_op->op_private & OPpFT_STACKED) {
+      if (PL_laststype != OP_LSTAT)

        Perl_croak(aTHX_ no_prev_lstat);
        Perl_croak(aTHX_ no_prev_lstat);

+      return PL_laststatval;
+    } 

 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;
 
     PL_laststype = OP_LSTAT;
     PL_statgv = NULL;

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 9304c49..020965b 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -839,6 +839,13 @@ this was not the case for C<goto &CORE::sub>.  The CORE sub would end up
 running with the lexical hints of the subroutine it replaced, instead of
 that subroutine's caller.  This has been fixed.
 
 running with the lexical hints of the subroutine it replaced, instead of
 that subroutine's caller.  This has been fixed.
 

+=item *
+
+Stacked C<-l> (followed immediately by other filetest operators) did not
+work previously; now it does.  It is only permitted when the rightmost
+filetest op has the special "_" handle for its argument and the most
+recent C<stat>/C<lstat> call was an C<lstat>.
+

 =back
 
 =head1 Known Problems
 =back
 
 =head1 Known Problems

diff --git a/pp_sys.c b/pp_sys.c
index eb324df..0a3d3cb 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3214,6 +3214,7 @@ PP(pp_ftlink)
     I32 result;
 
     tryAMAGICftest_MG('l');
     I32 result;
 
     tryAMAGICftest_MG('l');

+    STACKED_FTEST_CHECK;

     result = my_lstat_flags(0);
     SPAGAIN;
 
     result = my_lstat_flags(0);
     SPAGAIN;
 

diff --git a/t/op/filetest.t b/t/op/filetest.t
index 08380d1..3b09c2b 100644 (file)
--- a/t/op/filetest.t
+++ b/t/op/filetest.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 use Config;
 }
 
 use Config;

-plan(tests => 30 + 27*14);
+plan(tests => 33 + 27*14);

 
 ok( -d 'op' );
 ok( -f 'TEST' );
 
 ok( -d 'op' );
 ok( -f 'TEST' );


@@ -89,6 +89,29 @@ is( -f -s $tempfile, 0 );
 is( -s -f $tempfile, 0 );
 unlink_all $tempfile;
 
 is( -s -f $tempfile, 0 );
 unlink_all $tempfile;
 

+# stacked -l
+eval { -l -e "TEST" };
+like $@, qr/^The stat preceding -l _ wasn't an lstat at /,
+  'stacked -l non-lstat error with warnings off';
+{
+ local $^W = 1;
+ eval { -l -e "TEST" };
+ like $@, qr/^The stat preceding -l _ wasn't an lstat at /,
+  'stacked -l non-lstat error with warnings on';
+}
+# Make sure -l is using the previous stat buffer, and not using the previ-
+# ous op’s return value as a file name.
+SKIP: {
+ use Perl::OSType 'os_type';
+ if (os_type ne 'Unix') { skip "Not Unix", 1 }
+ chomp(my $ln = `which ln`);
+ if ( ! -e $ln ) { skip "No ln"   , 1 }
+ lstat "TEST";
+ `ln -s TEST 1`;
+ ok ! -l -e _, 'stacked -l uses previous stat, not previous retval';
+ unlink 1;
+}
+

 # test that _ is a bareword after filetest operators
 
 -f 'TEST';
 # test that _ is a bareword after filetest operators
 
 -f 'TEST';