In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/f26bc945e423a399a819716b3152e77ce33161ba?hp=15da1ccf5401cb5b69ab5ab40a17dd79ebcde211>
- Log ----------------------------------------------------------------- commit f26bc945e423a399a819716b3152e77ce33161ba Merge: 15da1cc d86b312 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 16:07:19 2014 -0800 [Merge] More OA_DANGEROUS stuff The OA_DANGEROUS op type flag indicates that an op might return a value referenced elsewhere, so list assignment should make tempor- ary copies. Some ops had this flag needlessly. Some lacked it erroneously, resulting in bugs. commit d86b31224ae14dba78f568f71804fe3016238a2c Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 14:44:46 2014 -0800 values and each are OA_DANGEROUS OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. values and each can both return scalars that are referenced elsewhere, causing list assignment to behave erratically if temporary copies are not made. M opcode.h M regen/opcodes M t/op/each.t M t/op/each_array.t M t/op/smartkve.t commit 0ec830cc003067236a70fbd947fbeb4cabdf09be Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 14:32:58 2014 -0800 smartkve.t doesnât need to disable dep warnings M t/op/smartkve.t commit 9618b155493c2adb474aedec3492236f030cfc7f Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 13:06:14 2014 -0800 kill is not OA_DANGEROUS OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. kill only ever returns a target unused elsewhere, so it does not necessitate temp copies in list assignment. M opcode.h M regen/opcodes commit 1062548aa8a260190f89d970b88ab8ffe0bb35b2 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 13:05:28 2014 -0800 exec is not OA_DANGEROUS OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. When exec fails, it only ever returns a target unused elsewhere, so it does not necessitate temp copies in list assignment. M opcode.h M regen/opcodes commit fc5ae97dc1cda30f5602828e5ee550c298f86a3f Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 13:03:45 2014 -0800 enterwrite is not OA_DANGEROUS OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. âwriteâ only ever returns a read-only true or false, so temp copies are not necessary for its sake. M opcode.h M regen/opcodes commit e518ea42e3594500d5b65ec487d88325c27f4f87 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 13:00:33 2014 -0800 Fix ext/B/t tests after OA_DANGEROUS removals M ext/B/t/f_sort.t M ext/B/t/optree_samples.t commit 6575cde09f3b8f22b60ff3c736fc7fba3ee0ef00 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:54:37 2014 -0800 tied is OA_DANGEROUS OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. tied returns the same scalar that the tied variables uses to hold a reference to the object (so weaken(tied(...)) works). tie uses the very scalar that TIESCALAR (or TIEWHATEVER) returns and attaches it to the tied variable by magic. That returned scalar could be referenced elsewhere. That means ($a, $b) = ($c, tied $d) could have common vars on either side, if the tie constructor for $d happened to return $a or $b. (Normally it would have to be an XSUB or an lvalue sub for its return value not to have been copied.) M opcode.h M regen/opcodes M t/op/tie.t commit 26812b4a900f5f8ec634ef9bb566822cb2b43975 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:45:13 2014 -0800 Remove OA_DANGEROUS from exit OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. exit usually doesnât return. When it fails, it returns a read-only undef, so we donât need temp copies for its sake. M opcode.h M regen/opcodes commit b31e13ff8bcc3b886cde8ce66380fc1032eaf4f9 Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:40:18 2014 -0800 Remove OA_DANGEROUS from loopctl-type ops OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. These operators never return, so they shouldnât necessitate temp copies. (This could probably apply to dump, too, but I donât fully under- stand dump.) M opcode.h M regen/opcodes commit 2eb514137a5f9f0f3b2e488949ceb974a7cbe2fe Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:38:32 2014 -0800 Remove OA_DANGEROUS from die OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. die never returns, so it shouldnât necessitate temp copies. M opcode.h M regen/opcodes commit aafd37e70de747bdeaa820466cb60c553c54882e Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:37:43 2014 -0800 Remove OA_DANGEROUS from cond_expr OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. ?: always returns one of its arguments. Since aassign_common_vars, which does the danger check, also checks the kids of the cond_expr op, it is not necessary for cond_expr to be flagged this way. M opcode.h M regen/opcodes commit f39944c15e410735fc6ec1ad2f9dfa84ea4e409d Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:36:02 2014 -0800 Remove OA_DANGEROUS from grep and map OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. grep returns its arguments, while map returns the results of its first expression. Since aassign_common_vars, which does the danger check, will also check the kids of the mapstart/grepstart ops, it is not nec- essary for grep and map themselves to be flagged this way. M opcode.h M regen/opcodes commit 61aeaf969d4829d2801f5ecc331dbd94627b2b8f Author: Father Chrysostomos <[email protected]> Date: Sat Nov 8 12:30:33 2014 -0800 Remove OA_DANGEROUS from sort OA_DANGEROUS indicates that temporary copies may need to be made in list assignment, to handle things like: ($a, $b) = ($b, $a); In other words, an op type is flagged with OA_DANGEROUS if its return values could occur elsewhere on the stack. pp_sort returns its arguments. aassign_common_vars will check its kid ops for danger as well, so itâs not necessary for sort itself to be flagged this way. This will allow cases like ($a,$b) = sort($c,$d) to forego the temp copy. M opcode.h M regen/opcodes ----------------------------------------------------------------------- Summary of changes: ext/B/t/f_sort.t | 48 ++++++++++++++++++++++++------------------------ ext/B/t/optree_samples.t | 4 ++-- opcode.h | 46 +++++++++++++++++++++++----------------------- regen/opcodes | 46 +++++++++++++++++++++++----------------------- t/op/each.t | 12 +++++++++++- t/op/each_array.t | 10 +++++++++- t/op/smartkve.t | 19 ++++++++++++++++++- t/op/tie.t | 15 +++++++++++++++ 8 files changed, 125 insertions(+), 75 deletions(-) diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index 65503ca..7205a94 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -60,7 +60,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t5] KS/COMMON +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 545 (eval 15):1) v @@ -72,7 +72,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -97,7 +97,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -109,7 +109,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -135,7 +135,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t10] KS/COMMON +# a <2> aassign[t10] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -148,7 +148,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -173,7 +173,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -185,7 +185,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -210,7 +210,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -222,7 +222,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -247,7 +247,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -259,7 +259,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -333,7 +333,7 @@ checkOptree(note => q{}, # 8 <0> pushmark s # 9 <#> gv[*sortedclass] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -347,7 +347,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*sortedclass) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -608,7 +608,7 @@ checkOptree(name => q{sort other::sub LIST }, # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 614 (eval 36):2) v:{ @@ -622,7 +622,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -650,7 +650,7 @@ checkOptree(note => q{}, # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -664,7 +664,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS/COMMON +# b <2> aassign[t3] KS # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -688,7 +688,7 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS/COMMON +# a <2> aassign[t14] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 578 (eval 15):1) v:%,{ @@ -701,7 +701,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -733,7 +733,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS/COMMON +# a <2> aassign[t14] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 578 (eval 15):1) v:%,{ @@ -746,7 +746,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS/COMMON +# a <2> aassign[t6] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -772,7 +772,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t8] KS/COMMON +# a <2> aassign[t8] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -785,7 +785,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t4] KS/COMMON +# a <2> aassign[t4] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index 61b0d18..c983268 100644 --- a/ext/B/t/optree_samples.t +++ b/ext/B/t/optree_samples.t @@ -437,7 +437,7 @@ checkOptree ( name => '@foo = grep(!/^\#/, @bar)', # a <0> pushmark s # b <#> gv[*foo] s # c <1> rv2av[t2] lKRM*/1 -# d <2> aassign[t6] KS/COMMON +# d <2> aassign[t6] KS # e <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 496 (eval 20):1) v:{ @@ -453,7 +453,7 @@ EOT_EOT # a <0> pushmark s # b <$> gv(*foo) s # c <1> rv2av[t1] lKRM*/1 -# d <2> aassign[t4] KS/COMMON +# d <2> aassign[t4] KS # e <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/opcode.h b/opcode.h index b3b46be..4f74cd1 100644 --- a/opcode.h +++ b/opcode.h @@ -1873,11 +1873,11 @@ EXTCONST U32 PL_opargs[] = { 0x00013204, /* aelem */ 0x00023401, /* aslice */ 0x00023401, /* kvaslice */ - 0x00003b00, /* aeach */ + 0x00003b40, /* aeach */ 0x00003b08, /* akeys */ - 0x00003b08, /* avalues */ - 0x00004b00, /* each */ - 0x00004b08, /* values */ + 0x00003b48, /* avalues */ + 0x00004b40, /* each */ + 0x00004b48, /* values */ 0x00004b08, /* keys */ 0x00001b00, /* delete */ 0x00001b04, /* exists */ @@ -1898,12 +1898,12 @@ EXTCONST U32 PL_opargs[] = { 0x0000bb04, /* pop */ 0x0000bb04, /* shift */ 0x0002341d, /* unshift */ - 0x0002d441, /* sort */ + 0x0002d401, /* sort */ 0x00002409, /* reverse */ - 0x00025441, /* grepstart */ - 0x00000348, /* grepwhile */ - 0x00025441, /* mapstart */ - 0x00000348, /* mapwhile */ + 0x00025401, /* grepstart */ + 0x00000308, /* grepwhile */ + 0x00025401, /* mapstart */ + 0x00000308, /* mapwhile */ 0x00011300, /* range */ 0x00011100, /* flip */ 0x00000100, /* flop */ @@ -1911,7 +1911,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000300, /* or */ 0x00011206, /* xor */ 0x00000300, /* dor */ - 0x00000340, /* cond_expr */ + 0x00000300, /* cond_expr */ 0x00000304, /* andassign */ 0x00000304, /* orassign */ 0x00000304, /* dorassign */ @@ -1921,7 +1921,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000100, /* leavesublv */ 0x00009b08, /* caller */ 0x0000240d, /* warn */ - 0x0000244d, /* die */ + 0x0000240d, /* die */ 0x00009b04, /* reset */ 0x00000400, /* lineseq */ 0x00000a04, /* nextstate */ @@ -1934,13 +1934,13 @@ EXTCONST U32 PL_opargs[] = { 0x00000000, /* iter */ 0x00000940, /* enterloop */ 0x00000200, /* leaveloop */ - 0x00002441, /* return */ - 0x00000d44, /* last */ - 0x00000d44, /* next */ - 0x00000d44, /* redo */ + 0x00002401, /* return */ + 0x00000d04, /* last */ + 0x00000d04, /* next */ + 0x00000d04, /* redo */ 0x00000d44, /* dump */ - 0x00000d44, /* goto */ - 0x00009b44, /* exit */ + 0x00000d04, /* goto */ + 0x00009b04, /* exit */ 0x00000e40, /* method_named */ 0x00000340, /* entergiven */ 0x00000100, /* leavegiven */ @@ -1956,14 +1956,14 @@ EXTCONST U32 PL_opargs[] = { 0x00096404, /* binmode */ 0x00217445, /* tie */ 0x00007b04, /* untie */ - 0x00007b04, /* tied */ + 0x00007b44, /* tied */ 0x00114404, /* dbmopen */ 0x00004b04, /* dbmclose */ 0x01111408, /* sselect */ 0x0000e40c, /* select */ 0x0000eb0c, /* getc */ 0x0917640d, /* read */ - 0x0000eb44, /* enterwrite */ + 0x0000eb04, /* enterwrite */ 0x00000100, /* leavewrite */ 0x0002e405, /* prtf */ 0x0002e405, /* print */ @@ -2043,8 +2043,8 @@ EXTCONST U32 PL_opargs[] = { 0x0000001c, /* wait */ 0x0001141c, /* waitpid */ 0x0002941d, /* system */ - 0x0002945d, /* exec */ - 0x0000245d, /* kill */ + 0x0002941d, /* exec */ + 0x0000241d, /* kill */ 0x0000001c, /* getppid */ 0x00009b1c, /* getpgrp */ 0x0009941c, /* setpgrp */ @@ -2109,9 +2109,9 @@ EXTCONST U32 PL_opargs[] = { 0x00007b04, /* lock */ 0x00000300, /* once */ 0x00000000, /* custom */ - 0x00001b00, /* reach */ + 0x00001b40, /* reach */ 0x00001b08, /* rkeys */ - 0x00001b08, /* rvalues */ + 0x00001b48, /* rvalues */ 0x00000600, /* coreargs */ 0x00000004, /* runcv */ 0x00009b8e, /* fc */ diff --git a/regen/opcodes b/regen/opcodes index 6d0e417..0176e55 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -219,14 +219,14 @@ aelem array element ck_null s2 A S aslice array slice ck_null m@ A L kvaslice index/value array slice ck_null m@ A L -aeach each on array ck_each % A +aeach each on array ck_each d% A akeys keys on array ck_each t% A -avalues values on array ck_each t% A +avalues values on array ck_each dt% A # Hashes. -each each ck_each % H -values values ck_each t% H +each each ck_each d% H +values values ck_each dt% H keys keys ck_each t% H delete delete ck_delete % S exists exists ck_exists is% S @@ -254,14 +254,14 @@ push push ck_fun imsT@ A L pop pop ck_shift s% A? shift shift ck_shift s% A? unshift unshift ck_fun imsT@ A L -sort sort ck_sort dm@ C? L +sort sort ck_sort m@ C? L reverse reverse ck_fun mt@ L -grepstart grep ck_grep dm@ C L -grepwhile grep iterator ck_null dt| +grepstart grep ck_grep m@ C L +grepwhile grep iterator ck_null t| -mapstart map ck_grep dm@ C L -mapwhile map iterator ck_null dt| +mapstart map ck_grep m@ C L +mapwhile map iterator ck_null t| # Range stuff. @@ -275,7 +275,7 @@ and logical and (&&) ck_null | or logical or (||) ck_null | xor logical xor ck_null fs2 S S dor defined or (//) ck_null | -cond_expr conditional expression ck_null d| +cond_expr conditional expression ck_null | andassign logical and assignment (&&=) ck_null s| orassign logical or assignment (||=) ck_null s| dorassign defined or assignment (//=) ck_null s| @@ -286,7 +286,7 @@ leavesub subroutine exit ck_null 1 leavesublv lvalue subroutine return ck_null 1 caller caller ck_fun t% S? warn warn ck_fun imst@ L -die die ck_fun dimst@ L +die die ck_fun imst@ L reset symbol reset ck_fun is% S? lineseq line sequence ck_null @ @@ -300,13 +300,13 @@ enteriter foreach loop entry ck_null d{ iter foreach loop iterator ck_null 0 enterloop loop entry ck_null d{ leaveloop loop exit ck_null 2 -return return ck_return dm@ L -last last ck_null ds} -next next ck_null ds} -redo redo ck_null ds} +return return ck_return m@ L +last last ck_null s} +next next ck_null s} +redo redo ck_null s} dump dump ck_null ds} -goto goto ck_null ds} -exit exit ck_fun ds% S? +goto goto ck_null s} +exit exit ck_fun s% S? method_named method with known name ck_null d. entergiven given() ck_null d| @@ -328,7 +328,7 @@ binmode binmode ck_fun s@ F S? tie tie ck_fun idms@ R S L untie untie ck_fun is% R -tied tied ck_fun s% R +tied tied ck_fun ds% R dbmopen dbmopen ck_fun is@ H S S dbmclose dbmclose ck_fun is% H @@ -337,7 +337,7 @@ select select ck_select st@ F? getc getc ck_eof st% F? read read ck_fun imst@ F R S S? -enterwrite write ck_fun dis% F? +enterwrite write ck_fun is% F? leavewrite write exit ck_null 1 prtf printf ck_listiob ims@ F? L @@ -442,8 +442,8 @@ fork fork ck_null ist0 wait wait ck_null isT0 waitpid waitpid ck_fun isT@ S S system system ck_exec imsT@ S? L -exec exec ck_exec dimsT@ S? L -kill kill ck_fun dimsT@ L +exec exec ck_exec imsT@ S? L +kill kill ck_fun imsT@ L getppid getppid ck_null isT0 getpgrp getpgrp ck_fun isT% S? setpgrp setpgrp ck_fun isT@ S? S? @@ -537,9 +537,9 @@ once once ck_null | custom unknown custom operator ck_null 0 # For smart dereference for each/keys/values -reach each on reference ck_each % S +reach each on reference ck_each d% S rkeys keys on reference ck_each t% S -rvalues values on reference ck_each t% S +rvalues values on reference ck_each dt% S # For CORE:: subs coreargs CORE:: subroutine ck_null $ diff --git a/t/op/each.t b/t/op/each.t index 3fc9451..b33fbac 100644 --- a/t/op/each.t +++ b/t/op/each.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 57; +plan tests => 59; $h{'abc'} = 'ABC'; $h{'def'} = 'DEF'; @@ -269,3 +269,13 @@ for my $k (qw(each keys values)) { } ok(!$warned, "no warnings 'internal' silences each() after insert warnings"); } + +use feature 'refaliasing'; +no warnings 'experimental::refaliasing'; +$a = 7; +\$h2{f} = \$a; +($a, $b) = (each %h2); +is "$a $b", "f 7", 'each in list assignment'; +$a = 7; +($a, $b) = (3, values %h2); +is "$a $b", "3 7", 'values in list assignment'; diff --git a/t/op/each_array.t b/t/op/each_array.t index 1055d6c..f6916dc 100644 --- a/t/op/each_array.t +++ b/t/op/each_array.t @@ -9,7 +9,7 @@ use strict; use warnings; use vars qw(@array @r $k $v $c); -plan tests => 63; +plan tests => 65; @array = qw(crunch zam bloop); @@ -187,3 +187,11 @@ for (; $k = each(@array) ;) { # Explicit reset while (each @array) { } } + +my $a = 7; +*a = sub { \@_ }->($a); +($a, $b) = each our @a; +is "$a $b", "0 7", 'each in list assignment'; +$a = 7; +($a, $b) = (3, values @a); +is "$a $b", "3 7", 'values in list assignment'; diff --git a/t/op/smartkve.t b/t/op/smartkve.t index bab5d61..1b54adc 100644 --- a/t/op/smartkve.t +++ b/t/op/smartkve.t @@ -7,7 +7,7 @@ BEGIN { } use strict; use warnings; -no warnings 'deprecated', 'experimental::autoderef'; +no warnings 'experimental::autoderef', 'experimental::refaliasing'; use vars qw($data $array $values $hash $errpat); plan 'no_plan'; @@ -450,3 +450,20 @@ my $over_a_h = Foo::Overload::ArrayOnHash->new; like($@, $errpat, "Overload: ambiguous dereference"); is($warn, '', "no warning issued"); $warn = ''; } + +use feature 'refaliasing'; +my $a = 7; +our %h; +\$h{f} = \$a; +($a, $b) = each \%h; +is "$a $b", "f 7", 'each \%hash in list assignment'; +$a = 7; +($a, $b) = (3, values \%h); +is "$a $b", "3 7", 'values \%hash in list assignment'; +*a = sub { \@_ }->($a); +$a = 7; +($a, $b) = each \our @a; +is "$a $b", "0 7", 'each \@array in list assignment'; +$a = 7; +($a, $b) = (3, values \@a); +is "$a $b", "3 7", 'values \@array in list assignment'; diff --git a/t/op/tie.t b/t/op/tie.t index aff685b..251e8bb 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -1451,3 +1451,18 @@ sub { print EXPECT crumpets +######## + +# tied() in list assignment + +sub TIESCALAR : lvalue { + ${+pop} = bless [], shift; +} +tie $t, "", \$a; +$a = 7; +($a, $b) = (3, tied $t); +print "a is $a\n"; +print "b is $b\n"; +EXPECT +a is 3 +b is 7 -- Perl5 Master Repository
