diff options
-rw-r--r-- | op.c | 48 | ||||
-rwxr-xr-x | t/io/open.t | 33 |
2 files changed, 77 insertions, 4 deletions
@@ -5108,9 +5108,51 @@ Perl_ck_fun(pTHX_ OP *o) else if (kid->op_type == OP_AELEM || kid->op_type == OP_HELEM) { - name = "__ANONIO__"; - len = 10; - mod(kid,type); + OP *op; + + name = 0; + if ((op = ((BINOP*)kid)->op_first)) { + SV *tmpstr = Nullsv; + char *a = + kid->op_type == OP_AELEM ? + "[]" : "{}"; + if (((op->op_type == OP_RV2AV) || + (op->op_type == OP_RV2HV)) && + (op = ((UNOP*)op)->op_first) && + (op->op_type == OP_GV)) { + /* packagevar $a[] or $h{} */ + GV *gv = cGVOPx_gv(op); + if (gv) + tmpstr = + Perl_newSVpvf(aTHX_ + "%s%c...%c", + GvNAME(gv), + a[0], a[1]); + } + else if (op->op_type == OP_PADAV + || op->op_type == OP_PADHV) { + /* lexicalvar $a[] or $h{} */ + char *padname = + PAD_COMPNAME_PV(op->op_targ); + if (padname) + tmpstr = + Perl_newSVpvf(aTHX_ + "%s%c...%c", + padname + 1, + a[0], a[1]); + + } + if (tmpstr) { + name = savepv(SvPVX(tmpstr)); + len = strlen(name); + sv_2mortal(tmpstr); + } + } + if (!name) { + name = "__ANONIO__"; + len = 10; + } + mod(kid, type); } if (name) { SV *namesv; diff --git a/t/io/open.t b/t/io/open.t index 9e067b74f6..300525ac05 100755 --- a/t/io/open.t +++ b/t/io/open.t @@ -12,7 +12,7 @@ use Config; $Is_VMS = $^O eq 'VMS'; $Is_MacOS = $^O eq 'MacOS'; -plan tests => 95; +plan tests => 99; my $Perl = which_perl(); @@ -244,3 +244,34 @@ SKIP: { ok( !eval { open F, "BAR", "QUUX" }, 'Unknown open() mode' ); like( $@, qr/\QUnknown open() mode 'BAR'/, ' right error' ); } + +{ + local $SIG{__WARN__} = sub { $@ = shift }; + + sub gimme { + my $tmphandle = shift; + my $line = scalar <$tmphandle>; + warn "gimme"; + return $line; + } + + open($fh0[0], "TEST"); + gimme($fh0[0]); + like($@, qr/<\$fh0\[...\]> line 1\./, "autoviv fh package aelem"); + + open($fh1{k}, "TEST"); + gimme($fh1{k}); + like($@, qr/<\$fh1{...}> line 1\./, "autoviv fh package helem"); + + my @fh2; + open($fh2[0], "TEST"); + gimme($fh2[0]); + like($@, qr/<\$fh2\[...\]> line 1\./, "autoviv fh lexical aelem"); + + my %fh3; + open($fh3{k}, "TEST"); + gimme($fh3{k}); + like($@, qr/<\$fh3{...}> line 1\./, "autoviv fh lexical helem"); + +} + |