diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-01-12 13:17:59 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-01-12 13:17:59 -0800 |
commit | e5e154d26bf2e9766b86a93f4af780f8b005349e (patch) | |
tree | 89ded710f86501579f9a209c7728b5ba28c1bfe2 | |
parent | 3f12cff414d1c6ec878a7e1a4ed270a421a8a75e (diff) | |
download | perl-e5e154d26bf2e9766b86a93f4af780f8b005349e.tar.gz |
Make -t, -T and -B with a handle pop it off the stack
This is something I broke carelessly with commit 094a3eec8.
No, this does not fix bug #77388.
-rw-r--r-- | pp_sys.c | 13 | ||||
-rw-r--r-- | t/op/filetest_stack_ok.t | 3 |
2 files changed, 9 insertions, 7 deletions
@@ -3258,15 +3258,17 @@ PP(pp_fttty) if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; - else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) { - tmpsv = POPs; + else { + tmpsv = POPs; + if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) { name = SvPV_nomg(tmpsv, namelen); gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO); + } } if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); - else if (tmpsv && SvOK(tmpsv)) { + else if (!gv && SvOK(tmpsv)) { if (isDIGIT(*name)) fd = atoi(name); else @@ -3297,7 +3299,7 @@ PP(pp_fttext) STDCHAR tbuf[512]; register STDCHAR *s; register IO *io; - register SV *sv; + register SV *sv = NULL; GV *gv; PerlIO *fp; @@ -3307,7 +3309,7 @@ PP(pp_fttext) if (PL_op->op_flags & OPf_REF) gv = cGVOP_gv; - else gv = MAYBE_DEREF_GV_nomg(TOPs); + else sv = POPs, gv = MAYBE_DEREF_GV_nomg(sv); if (gv) { EXTEND(SP, 1); @@ -3357,7 +3359,6 @@ PP(pp_fttext) } } else { - sv = POPs; really_filename: PL_statgv = NULL; PL_laststype = OP_STAT; diff --git a/t/op/filetest_stack_ok.t b/t/op/filetest_stack_ok.t index 3c212b16fa..dba5f6549d 100644 --- a/t/op/filetest_stack_ok.t +++ b/t/op/filetest_stack_ok.t @@ -12,10 +12,11 @@ BEGIN { my @ops = split //, 'rwxoRWXOezsfdlpSbctugkTMBAC'; -plan( tests => @ops * 3 ); +plan( tests => @ops * 4 ); for my $op (@ops) { ok( 1 == @{ [ eval "-$op 'TEST'" ] }, "-$op returns single value" ); + ok( 1 == @{ [ eval "-$op *TEST" ] }, "-$op *gv returns single value" ); my $count = 0; my $t; |