t/mro/vulcan_dfs_utf8.t utf8 mro tests
toke.c The tokener
t/op/64bitint.t See if 64 bit integers work
+t/op/aassign.t test list assign
t/op/alarm.t See if alarm works
t/op/anonconst.t See if :const works
t/op/anonsub.t See if anonymous subroutines work
Apa |OP* |newANONLIST |NULLOK OP* o
Apa |OP* |newANONHASH |NULLOK OP* o
Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block
-#if defined(PERL_IN_OP_C)
-i |bool |aassign_common_vars |NULLOK OP* o
-#endif
Apda |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right
Apda |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop
Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv
#define mro_get_linear_isa_dfs(a,b) S_mro_get_linear_isa_dfs(aTHX_ a,b)
# endif
# if defined(PERL_IN_OP_C)
-#define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
#define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c)
#define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d)
#define assignment_type(a) S_assignment_type(aTHX_ a)
# a <0> pushmark s
# b <#> gv[*chars] s
# c <1> rv2av[t2] lKRM*/1
-# d <2> aassign[t9] KS/COMMON
+# d <2> aassign[t9] KS/COM_AGG
# e <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 559 (eval 15):1) v
# a <0> pushmark s
# b <$> gv(*chars) s
# c <1> rv2av[t1] lKRM*/1
-# d <2> aassign[t6] KS/COMMON
+# d <2> aassign[t6] KS/COM_AGG
# e <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# g <0> pushmark s
# h <#> gv[*hash] s
# i <1> rv2hv lKRM*/1
-# j <2> aassign[t10] KS/COMMON
+# j <2> aassign[t10] KS/COM_AGG
# k <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 560 (eval 15):1) v:{
# g <0> pushmark s
# h <$> gv(*hash) s
# i <1> rv2hv lKRM*/1
-# j <2> aassign[t5] KS/COMMON
+# j <2> aassign[t5] KS/COM_AGG
# k <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# b <0> pushmark s
# c <#> gv[*hash] s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t10] KS/COMMON
+# e <2> aassign[t10] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 560 (eval 15):1) v
# b <0> pushmark s
# c <$> gv(*hash) s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t6] KS/COMMON
+# e <2> aassign[t6] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# b <0> pushmark s
# c <#> gv[*hash] s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t10] KS/COMMON
+# e <2> aassign[t10] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 560 (eval 15):1) v
# b <0> pushmark s
# c <$> gv(*hash) s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t6] KS/COMMON
+# e <2> aassign[t6] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# b <0> pushmark s
# c <#> gv[*hash] s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t9] KS/COMMON
+# e <2> aassign[t9] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 589 (eval 26):1) v
# b <0> pushmark s
# c <$> gv(*hash) s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t5] KS/COMMON
+# e <2> aassign[t5] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# b <0> pushmark s
# c <#> gv[*hash] s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t8] KS/COMMON
+# e <2> aassign[t8] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 593 (eval 28):1) v
# b <0> pushmark s
# c <$> gv(*hash) s
# d <1> rv2hv lKRM*/1
-# e <2> aassign[t5] KS/COMMON
+# e <2> aassign[t5] KS/COM_AGG
# f <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# a <0> pushmark s
# b <#> gv[*hash] s
# c <1> rv2hv lKRM*/1
-# d <2> aassign[t6] KS/COMMON
+# d <2> aassign[t6] KS/COM_AGG
# e <#> gv[*array] s
# f <1> rv2av[t8] K/1
# g <@> list K
# a <0> pushmark s
# b <$> gv(*hash) s
# c <1> rv2hv lKRM*/1
-# d <2> aassign[t4] KS/COMMON
+# d <2> aassign[t4] KS/COM_AGG
# e <$> gv(*array) s
# f <1> rv2av[t5] K/1
# g <@> list K
# d <0> pushmark s
# e <#> gv[*hashes] s
# f <1> rv2av[t2] lKRM*/1
-# g <2> aassign[t8] KS/COMMON
+# g <2> aassign[t8] KS/COM_AGG
# h <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 601 (eval 32):1) v
# d <0> pushmark s
# e <$> gv(*hashes) s
# f <1> rv2av[t1] lKRM*/1
-# g <2> aassign[t5] KS/COMMON
+# g <2> aassign[t5] KS/COM_AGG
# h <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t5] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 545 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t10] KS
+# a <2> aassign[t10] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*eldest] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t11] KS/COMMON
+# b <2> aassign[t11] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*eldest) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t5] KS/COMMON
+# b <2> aassign[t5] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*sortedclass] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*sortedclass) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# n <0> pushmark s
# o <#> gv[*new] s
# p <1> rv2av[t2] lKRM*/1
-# q <2> aassign[t22] KS/COMMON
+# q <2> aassign[t22] KS/COM_AGG
# r <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 609 (eval 34):3) v:{
# n <0> pushmark s
# o <$> gv(*new) s
# p <1> rv2av[t1] lKRM*/1
-# q <2> aassign[t13] KS/COMMON
+# q <2> aassign[t13] KS/COM_AGG
# r <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*new] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 614 (eval 36):2) v:{
# 8 <0> pushmark s
# 9 <$> gv(*new) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*new] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*new) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COM_AGG
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*new] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t14] KS
+# a <2> aassign[t14] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
# 7 <0> pushmark s
# 8 <$> gv(*new) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*new] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t14] KS
+# a <2> aassign[t14] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
# 7 <0> pushmark s
# 8 <$> gv(*new) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t8] KS
+# a <2> aassign[t8] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t4] KS
+# a <2> aassign[t4] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# d <0> pushmark s
# e <#> gv[*result] s
# f <1> rv2av[t2] lKRM*/1
-# g <2> aassign[t3] KS/COMMON
+# g <2> aassign[t3] KS/COM_AGG
# h <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 547 (eval 15):1) v
# d <0> pushmark s
# e <$> gv(*result) s
# f <1> rv2av[t1] lKRM*/1
-# g <2> aassign[t2] KS/COMMON
+# g <2> aassign[t2] KS/COM_AGG
# h <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# - <0> padsv[$x:1,2] vM/LVINTRO ->-
# - <0> padsv[$y:1,2] vM/LVINTRO ->-
# 3 <;> nextstate(main 2 -e:1) v:>,<,% ->4
-# 8 <2> aassign[t4] vKS ->9
+# 8 <2> aassign[t4] vKS/COM_AGG ->9
# - <1> ex-list lKP ->5
# 4 <0> padrange[$x:1,2; $y:1,2] /2 ->5
# - <0> padsv[$x:1,2] s ->-
# 7 <1> rv2av[t3] lKRM*/1 ->8
# 6 <#> gv[*a] s ->7
# 9 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a
-# e <2> aassign[t6] KS ->f
+# e <2> aassign[t6] KS/COM_RC1 ->f
# - <1> ex-list lK ->d
# a <0> pushmark s ->b
# c <1> rv2av[t5] lK/1 ->d
# - <0> padsv[$x:1,2] vM/LVINTRO ->-
# - <0> padsv[$y:1,2] vM/LVINTRO ->-
# 3 <;> nextstate(main 2 -e:1) v:>,<,% ->4
-# 8 <2> aassign[t4] vKS ->9
+# 8 <2> aassign[t4] vKS/COM_AGG ->9
# - <1> ex-list lKP ->5
# 4 <0> padrange[$x:1,2; $y:1,2] /2 ->5
# - <0> padsv[$x:1,2] s ->-
# 7 <1> rv2av[t3] lKRM*/1 ->8
# 6 <$> gv(*a) s ->7
# 9 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a
-# e <2> aassign[t6] KS ->f
+# e <2> aassign[t6] KS/COM_RC1 ->f
# - <1> ex-list lK ->d
# a <0> pushmark s ->b
# c <1> rv2av[t5] lK/1 ->d
# d <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->d
# 1 <;> nextstate(main 1 p3:1) v:>,<,% ->2
-# 3 <2> aassign[t5] vKS ->4
+# 3 <2> aassign[t5] vKS/COM_RC1 ->4
# - <1> ex-list lK ->-
# 2 <0> padrange[$a:1,4; $b:1,4] */LVINTRO,2 ->3
# - <1> rv2av[t4] lK/1 ->-
# - <0> padsv[$a:1,4] sRM*/LVINTRO ->-
# - <0> padsv[$b:1,4] sRM*/LVINTRO ->-
# 4 <;> nextstate(main 2 p3:2) v:>,<,% ->5
-# 9 <2> aassign[t10] vKS ->a
+# 9 <2> aassign[t10] vKS/COM_RC1 ->a
# - <1> ex-list lK ->8
# 5 <0> pushmark s ->6
# 7 <1> rv2av[t9] lK/1 ->8
# - <0> padsv[$c:2,4] sRM*/LVINTRO ->-
# - <0> padsv[$d:2,4] sRM*/LVINTRO ->-
# a <;> nextstate(Y 3 p3:4) v:>,<,%,{ ->b
-# c <2> aassign[t15] KS ->d
+# c <2> aassign[t15] KS/COM_RC1 ->d
# - <1> ex-list lK ->-
# b <0> padrange[$e:3,4; $f:3,4] */LVINTRO,2 ->c
# - <1> rv2av[t14] lK/1 ->-
# d <1> leavesub[1 ref] K/REFC,1 ->(end)
# - <@> lineseq KP ->d
# 1 <;> nextstate(main 1 p3:1) v:>,<,% ->2
-# 3 <2> aassign[t5] vKS ->4
+# 3 <2> aassign[t5] vKS/COM_RC1 ->4
# - <1> ex-list lK ->-
# 2 <0> padrange[$a:1,4; $b:1,4] */LVINTRO,2 ->3
# - <1> rv2av[t4] lK/1 ->-
# - <0> padsv[$a:1,4] sRM*/LVINTRO ->-
# - <0> padsv[$b:1,4] sRM*/LVINTRO ->-
# 4 <;> nextstate(main 2 p3:2) v:>,<,% ->5
-# 9 <2> aassign[t10] vKS ->a
+# 9 <2> aassign[t10] vKS/COM_RC1 ->a
# - <1> ex-list lK ->8
# 5 <0> pushmark s ->6
# 7 <1> rv2av[t9] lK/1 ->8
# - <0> padsv[$c:2,4] sRM*/LVINTRO ->-
# - <0> padsv[$d:2,4] sRM*/LVINTRO ->-
# a <;> nextstate(Y 3 p3:4) v:>,<,%,{ ->b
-# c <2> aassign[t15] KS ->d
+# c <2> aassign[t15] KS/COM_RC1 ->d
# - <1> ex-list lK ->-
# b <0> padrange[$e:3,4; $f:3,4] */LVINTRO,2 ->c
# - <1> rv2av[t14] lK/1 ->-
# a <0> pushmark s
# b <#> gv[*foo] s
# c <1> rv2av[t2] lKRM*/1
-# d <2> aassign[t6] KS
+# d <2> aassign[t6] KS/COM_AGG
# e <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 496 (eval 20):1) v:{
# a <0> pushmark s
# b <$> gv(*foo) s
# c <1> rv2av[t1] lKRM*/1
-# d <2> aassign[t4] KS
+# d <2> aassign[t4] KS/COM_AGG
# e <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# h <#> gv[*h] s
# i <1> rv2hv[t2] lKRM*/1 < 5.019006
# i <1> rv2hv lKRM*/1 >=5.019006
-# j <2> aassign[t10] KS/COMMON
+# j <2> aassign[t10] KS/COM_AGG
# k <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 501 (eval 22):1) v:{
# h <$> gv(*h) s
# i <1> rv2hv[t1] lKRM*/1 < 5.019006
# i <1> rv2hv lKRM*/1 >=5.019006
-# j <2> aassign[t5] KS/COMMON
+# j <2> aassign[t5] KS/COM_AGG
# k <1> leavesub[1 ref] K/REFC,1
EONT_EONT
7 <0> pushmark s
8 <#> gv[*a] s
9 <1> rv2av[t2] lKRM*/1
-a <2> aassign[t5] KS/COMMON
+a <2> aassign[t5] KS/COM_AGG
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 65 optree.t:311) v:>,<,%
# 7 <0> pushmark s
# 8 <$> gv(*a) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t3] KS/COMMON
+# a <2> aassign[t3] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
7 <@> sort lK
8 <0> pushmark s
9 <0> padav[@a:-437,-436] lRM*
-a <2> aassign[t2] KS/COMMON
+a <2> aassign[t2] KS/COM_AGG
b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 427 optree_sort.t:172) v:>,<,%
# 7 <@> sort lK
# 8 <0> pushmark s
# 9 <0> padav[@a:-437,-436] lRM*
-# a <2> aassign[t2] KS/COMMON
+# a <2> aassign[t2] KS/COM_AGG
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
},
);
-@{$bits{aassign}}{6,1,0} = ('OPpASSIGN_COMMON', $bf[1], $bf[1]);
+@{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]);
$bits{abs}{0} = $bf[0];
@{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
@{$bits{add}}{1,0} = ($bf[1], $bf[1]);
OPpARG3_MASK => 7,
OPpARG4_MASK => 15,
OPpASSIGN_BACKWARDS => 64,
- OPpASSIGN_COMMON => 64,
+ OPpASSIGN_COMMON_AGG => 16,
+ OPpASSIGN_COMMON_RC1 => 32,
+ OPpASSIGN_COMMON_SCALAR => 64,
OPpASSIGN_CV_TO_GV => 128,
OPpCONST_BARE => 64,
OPpCONST_ENTERED => 16,
our %labels = (
OPpALLOW_FAKE => 'FAKE',
OPpASSIGN_BACKWARDS => 'BKWARD',
- OPpASSIGN_COMMON => 'COMMON',
+ OPpASSIGN_COMMON_AGG => 'COM_AGG',
+ OPpASSIGN_COMMON_RC1 => 'COM_RC1',
+ OPpASSIGN_COMMON_SCALAR => 'COM_SCALAR',
OPpASSIGN_CV_TO_GV => 'CV2GV',
OPpCONST_BARE => 'BARE',
OPpCONST_ENTERED => 'ENTERED',
our %ops_using = (
OPpALLOW_FAKE => [qw(rv2gv)],
OPpASSIGN_BACKWARDS => [qw(sassign)],
- OPpASSIGN_COMMON => [qw(aassign)],
+ OPpASSIGN_COMMON_AGG => [qw(aassign)],
OPpCONST_BARE => [qw(const)],
OPpCOREARGS_DEREF1 => [qw(coreargs)],
OPpEARLY_CV => [qw(gv)],
OPpTRANS_COMPLEMENT => [qw(trans transr)],
);
+$ops_using{OPpASSIGN_COMMON_RC1} = $ops_using{OPpASSIGN_COMMON_AGG};
+$ops_using{OPpASSIGN_COMMON_SCALAR} = $ops_using{OPpASSIGN_COMMON_AGG};
$ops_using{OPpASSIGN_CV_TO_GV} = $ops_using{OPpASSIGN_BACKWARDS};
$ops_using{OPpCONST_ENTERED} = $ops_using{OPpCONST_BARE};
$ops_using{OPpCONST_NOVER} = $ops_using{OPpCONST_BARE};
return ret;
}
-/*
- Helper function for newASSIGNOP to detect commonality between the
- lhs and the rhs. (It is actually called very indirectly. newASSIGNOP
- flags the op and the peephole optimizer calls this helper function
- if the flag is set.) Marks all variables with PL_generation. If it
- returns TRUE the assignment must be able to handle common variables.
-
- PL_generation sorcery:
- An assignment like ($a,$b) = ($c,$d) is easier than
- ($a,$b) = ($c,$a), since there is no need for temporary vars.
- To detect whether there are common vars, the global var
- PL_generation is incremented for each assign op we compile.
- Then, while compiling the assign op, we run through all the
- variables on both sides of the assignment, setting a spare slot
- in each of them to PL_generation. If any of them already have
- that value, we know we've got commonality. Also, if the
- generation number is already set to PERL_INT_MAX, then
- the variable is involved in aliasing, so we also have
- potential commonality in that case. We could use a
- single bit marker, but then we'd have to make 2 passes, first
- to clear the flag, then to test and set it. And that
- wouldn't help with aliasing, either. To find somewhere
- to store these values, evil chicanery is done with SvUVX().
-*/
-PERL_STATIC_INLINE bool
-S_aassign_common_vars(pTHX_ OP* o)
-{
- OP *curop;
- for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
- if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
- if (curop->op_type == OP_GV || curop->op_type == OP_GVSV
- || curop->op_type == OP_AELEMFAST) {
- GV *gv = cGVOPx_gv(curop);
- if (gv == PL_defgv
- || (int)GvASSIGN_GENERATION(gv) == PL_generation)
- return TRUE;
- GvASSIGN_GENERATION_set(gv, PL_generation);
- }
- else if (curop->op_type == OP_PADSV ||
- curop->op_type == OP_PADAV ||
- curop->op_type == OP_PADHV ||
- curop->op_type == OP_AELEMFAST_LEX ||
- curop->op_type == OP_PADANY)
- {
- padcheck:
- if (PAD_COMPNAME_GEN(curop->op_targ)
- == (STRLEN)PL_generation
- || PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
- return TRUE;
- PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
-
- }
- else if (curop->op_type == OP_RV2CV)
- return TRUE;
- else if (curop->op_type == OP_RV2SV ||
- curop->op_type == OP_RV2AV ||
- curop->op_type == OP_RV2HV ||
- curop->op_type == OP_RV2GV) {
- if (cUNOPx(curop)->op_first->op_type != OP_GV) /* funny deref? */
- return TRUE;
- }
- else if (curop->op_type == OP_PUSHRE) {
- GV *const gv =
-#ifdef USE_ITHREADS
- ((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff
- ? MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff))
- : NULL;
-#else
- ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
-#endif
- if (gv) {
- if (gv == PL_defgv
- || (int)GvASSIGN_GENERATION(gv) == PL_generation)
- return TRUE;
- GvASSIGN_GENERATION_set(gv, PL_generation);
- }
- else if (curop->op_targ)
- goto padcheck;
- }
- else if (curop->op_type == OP_PADRANGE)
- /* Ignore padrange; checking its siblings is sufficient. */
- continue;
- else
- return TRUE;
- }
- else if (PL_opargs[curop->op_type] & OA_TARGLEX
- && curop->op_private & OPpTARGET_MY)
- goto padcheck;
-
- if (curop->op_flags & OPf_KIDS) {
- if (aassign_common_vars(curop))
- return TRUE;
- }
- }
- return FALSE;
-}
-
-/* This variant only handles lexical aliases. It is called when
- newASSIGNOP decides that we don’t have any common vars, as lexical ali-
- ases trump that decision. */
-PERL_STATIC_INLINE bool
-S_aassign_common_vars_aliases_only(pTHX_ OP *o)
-{
- OP *curop;
- for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
- if ((curop->op_type == OP_PADSV ||
- curop->op_type == OP_PADAV ||
- curop->op_type == OP_PADHV ||
- curop->op_type == OP_AELEMFAST_LEX ||
- curop->op_type == OP_PADANY ||
- ( PL_opargs[curop->op_type] & OA_TARGLEX
- && curop->op_private & OPpTARGET_MY ))
- && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
- return TRUE;
-
- if (curop->op_type == OP_PUSHRE && curop->op_targ
- && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
- return TRUE;
-
- if (curop->op_flags & OPf_KIDS) {
- if (S_aassign_common_vars_aliases_only(aTHX_ curop))
- return TRUE;
- }
- }
- return FALSE;
-}
/*
=for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right
static const char no_list_state[] = "Initialization of state variables"
" in list context currently forbidden";
OP *curop;
- bool maybe_common_vars = TRUE;
if (left->op_type == OP_ASLICE || left->op_type == OP_HSLICE)
left->op_private &= ~ OPpSLICEWARNING;
if (OP_TYPE_IS_OR_WAS(left, OP_LIST))
{
OP* lop = ((LISTOP*)left)->op_first;
- maybe_common_vars = FALSE;
while (lop) {
- if (lop->op_type == OP_PADSV ||
- lop->op_type == OP_PADAV ||
- lop->op_type == OP_PADHV ||
- lop->op_type == OP_PADANY) {
- if (!(lop->op_private & OPpLVAL_INTRO))
- maybe_common_vars = TRUE;
-
- if (lop->op_private & OPpPAD_STATE) {
- if (left->op_private & OPpLVAL_INTRO) {
- /* Each variable in state($a, $b, $c) = ... */
- }
- else {
- /* Each state variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- yyerror(no_list_state);
- } else {
- /* Each my variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- } else if (lop->op_type == OP_UNDEF ||
- OP_TYPE_IS_OR_WAS(lop, OP_PUSHMARK)) {
- /* undef may be interesting in
- (state $a, undef, state $c) */
- } else {
- /* Other ops in the list. */
- maybe_common_vars = TRUE;
- }
+ if ((lop->op_type == OP_PADSV ||
+ lop->op_type == OP_PADAV ||
+ lop->op_type == OP_PADHV ||
+ lop->op_type == OP_PADANY)
+ && (lop->op_private & OPpPAD_STATE)
+ )
+ yyerror(no_list_state);
lop = OpSIBLING(lop);
}
}
- else if ((left->op_private & OPpLVAL_INTRO)
+ else if ( (left->op_private & OPpLVAL_INTRO)
+ && (left->op_private & OPpPAD_STATE)
&& ( left->op_type == OP_PADSV
|| left->op_type == OP_PADAV
|| left->op_type == OP_PADHV
- || left->op_type == OP_PADANY))
- {
- if (left->op_type == OP_PADSV) maybe_common_vars = FALSE;
- if (left->op_private & OPpPAD_STATE) {
+ || left->op_type == OP_PADANY)
+ ) {
/* All single variable list context state assignments, hence
state ($a) = ...
(state $a) = ...
(state %a) = ...
*/
yyerror(no_list_state);
- }
- }
-
- if (maybe_common_vars) {
- /* The peephole optimizer will do the full check and pos-
- sibly turn this off. */
- o->op_private |= OPpASSIGN_COMMON;
}
if (right && right->op_type == OP_SPLIT
return o;
}
+
+
+/*
+ ---------------------------------------------------------
+
+ Common vars in list assignment
+
+ There now follows some enums and static functions for detecting
+ common variables in list assignments. Here is a little essay I wrote
+ for myself when trying to get my head around this. DAPM.
+
+ ----
+
+ First some random observations:
+
+ * If a lexical var is an alias of something else, e.g.
+ for my $x ($lex, $pkg, $a[0]) {...}
+ then the act of aliasing will increase the reference count of the SV
+
+ * If a package var is an alias of something else, it may still have a
+ reference count of 1, depending on how the alias was created, e.g.
+ in *a = *b, $a may have a refcount of 1 since the GP is shared
+ with a single GvSV pointer to the SV. So If it's an alias of another
+ package var, then RC may be 1; if it's an alias of another scalar, e.g.
+ a lexical var or an array element, then it will have RC > 1.
+
+ * There are many ways to create a package alias; ultimately, XS code
+ may quite legally do GvSV(gv) = SvREFCNT_inc(sv) for example, so
+ run-time tracing mechanisms are unlikely to be able to catch all cases.
+
+ * When the LHS is all my declarations, the same vars can't appear directly
+ on the RHS, but they can indirectly via closures, aliasing and lvalue
+ subs. But those techniques all involve an increase in the lexical
+ scalar's ref count.
+
+ * When the LHS is all lexical vars (but not necessarily my declarations),
+ it is possible for the same lexicals to appear directly on the RHS, and
+ without an increased ref count, since the stack isn't refcounted.
+ This case can be detected at compile time by scanning for common lex
+ vars with PL_generation.
+
+ * lvalue subs defeat common var detection, but they do at least
+ return vars with a temporary ref count increment. Also, you can't
+ tell at compile time whether a sub call is lvalue.
+
+
+ So...
+
+ A: There are a few circumstances where there definitely can't be any
+ commonality:
+
+ LHS empty: () = (...);
+ RHS empty: (....) = ();
+ RHS contains only constants or other 'can't possibly be shared'
+ elements (e.g. ops that return PADTMPs): (...) = (1,2, length)
+ i.e. they only contain ops not marked as dangerous, whose children
+ are also not dangerous;
+ LHS ditto;
+ LHS contains a single scalar element: e.g. ($x) = (....); because
+ after $x has been modified, it won't be used again on the RHS;
+ RHS contains a single element with no aggregate on LHS: e.g.
+ ($a,$b,$c) = ($x); again, once $a has been modified, its value
+ won't be used again.
+
+ B: If LHS are all 'my' lexical var declarations (or safe ops, which
+ we can ignore):
+
+ my ($a, $b, @c) = ...;
+
+ Due to closure and goto tricks, these vars may already have content.
+ For the same reason, an element on the RHS may be a lexical or package
+ alias of one of the vars on the left, or share common elements, for
+ example:
+
+ my ($x,$y) = f(); # $x and $y on both sides
+ sub f : lvalue { ($x,$y) = (1,2); $y, $x }
+
+ and
+
+ my $ra = f();
+ my @a = @$ra; # elements of @a on both sides
+ sub f { @a = 1..4; \@a }
+
+
+ First, just consider scalar vars on LHS:
+
+ RHS is safe only if (A), or in addition,
+ * contains only lexical *scalar* vars, where neither side's
+ lexicals have been flagged as aliases
+
+ If RHS is not safe, then it's always legal to check LHS vars for
+ RC==1, since the only RHS aliases will always be associated
+ with an RC bump.
+
+ Note that in particular, RHS is not safe if:
+
+ * it contains package scalar vars; e.g.:
+
+ f();
+ my ($x, $y) = (2, $x_alias);
+ sub f { $x = 1; *x_alias = \$x; }
+
+ * It contains other general elements, such as flattened or
+ * spliced or single array or hash elements, e.g.
+
+ f();
+ my ($x,$y) = @a; # or $a[0] or @a{@b} etc
+
+ sub f {
+ ($x, $y) = (1,2);
+ use feature 'refaliasing';
+ \($a[0], $a[1]) = \($y,$x);
+ }
+
+ It doesn't matter if the array/hash is lexical or package.
+
+ * it contains a function call that happens to be an lvalue
+ sub which returns one or more of the above, e.g.
+
+ f();
+ my ($x,$y) = f();
+
+ sub f : lvalue {
+ ($x, $y) = (1,2);
+ *x1 = \$x;
+ $y, $x1;
+ }
+
+ (so a sub call on the RHS should be treated the same
+ as having a package var on the RHS).
+
+ * any other "dangerous" thing, such an op or built-in that
+ returns one of the above, e.g. pp_preinc
+
+
+ If RHS is not safe, what we can do however is at compile time flag
+ that the LHS are all my declarations, and at run time check whether
+ all the LHS have RC == 1, and if so skip the full scan.
+
+ Now consider array and hash vars on LHS: e.g. my (...,@a) = ...;
+
+ Here the issue is whether there can be elements of @a on the RHS
+ which will get prematurely freed when @a is cleared prior to
+ assignment. This is only a problem if the aliasing mechanism
+ is one which doesn't increase the refcount - only if RC == 1
+ will the RHS element be prematurely freed.
+
+ Because the array/hash is being INTROed, it or its elements
+ can't directly appear on the RHS:
+
+ my (@a) = ($a[0], @a, etc) # NOT POSSIBLE
+
+ but can indirectly, e.g.:
+
+ my $r = f();
+ my (@a) = @$r;
+ sub f { @a = 1..3; \@a }
+
+ So if the RHS isn't safe as defined by (A), we must always
+ mortalise and bump the ref count of any remaining RHS elements
+ when assigning to a non-empty LHS aggregate.
+
+ Lexical scalars on the RHS aren't safe if they've been involved in
+ aliasing, e.g.
+
+ use feature 'refaliasing';
+
+ f();
+ \(my $lex) = \$pkg;
+ my @a = ($lex,3); # equivalent to ($a[0],3)
+
+ sub f {
+ @a = (1,2);
+ \$pkg = \$a[0];
+ }
+
+ Similarly with lexical arrays and hashes on the RHS:
+
+ f();
+ my @b;
+ my @a = (@b);
+
+ sub f {
+ @a = (1,2);
+ \$b[0] = \$a[1];
+ \$b[1] = \$a[0];
+ }
+
+
+
+ C: As (B), but in addition the LHS may contain non-intro lexicals, e.g.
+ my $a; ($a, my $b) = (....);
+
+ The difference between (B) and (C) is that it is now physically
+ possible for the LHS vars to appear on the RHS too, where they
+ are not reference counted; but in this case, the compile-time
+ PL_generation sweep will detect such common vars.
+
+ So the rules for (C) differ from (B) in that if common vars are
+ detected, the runtime "test RC==1" optimisation can no longer be used,
+ and a full mark and sweep is required
+
+ D: As (C), but in addition the LHS may contain package vars.
+
+ Since package vars can be aliased without a corresponding refcount
+ increase, all bets are off. It's only safe if (A). E.g.
+
+ my ($x, $y) = (1,2);
+
+ for $x_alias ($x) {
+ ($x_alias, $y) = (3, $x); # whoops
+ }
+
+ Ditto for LHS aggregate package vars.
+
+ E: Any other dangerous ops on LHS, e.g.
+ (f(), $a[0], @$r) = (...);
+
+ this is similar to (E) in that all bets are off. In addition, it's
+ impossible to determine at compile time whether the LHS
+ contains a scalar or an aggregate, e.g.
+
+ sub f : lvalue { @a }
+ (f()) = 1..3;
+
+* ---------------------------------------------------------
+*/
+
+
+/* A set of bit flags returned by S_aassign_scan(). Each flag indicates
+ * that at least one of the things flagged was seen.
+ */
+
+enum {
+ AAS_MY_SCALAR = 0x001, /* my $scalar */
+ AAS_MY_AGG = 0x002, /* aggregate: my @array or my %hash */
+ AAS_LEX_SCALAR = 0x004, /* $lexical */
+ AAS_LEX_AGG = 0x008, /* @lexical or %lexical aggregate */
+ AAS_LEX_SCALAR_COMM = 0x010, /* $lexical seen on both sides */
+ AAS_PKG_SCALAR = 0x020, /* $scalar (where $scalar is pkg var) */
+ AAS_PKG_AGG = 0x040, /* package @array or %hash aggregate */
+ AAS_DANGEROUS = 0x080, /* an op (other than the above)
+ that's flagged OA_DANGEROUS */
+ AAS_SAFE_SCALAR = 0x100, /* produces at least one scalar SV that's
+ not in any of the categories above */
+};
+
+
+
+/* helper function for S_aassign_scan().
+ * check a PAD-related op for commonality and/or set its generation number.
+ * Returns a boolean indicating whether its shared */
+
+static bool
+S_aassign_padcheck(pTHX_ OP* o, bool rhs)
+{
+ if (PAD_COMPNAME_GEN(o->op_targ) == PERL_INT_MAX)
+ /* lexical used in aliasing */
+ return TRUE;
+
+ if (rhs)
+ return cBOOL(PAD_COMPNAME_GEN(o->op_targ) == (STRLEN)PL_generation);
+ else
+ PAD_COMPNAME_GEN_set(o->op_targ, PL_generation);
+
+ return FALSE;
+}
+
+
+/*
+ Helper function for OPpASSIGN_COMMON* detection in rpeep().
+ It scans the left or right hand subtree of the aassign op, and returns a
+ set of flags indicating what sorts of things it found there.
+ 'rhs' indicates whether we're scanning the LHS or RHS. If the former, we
+ set PL_generation on lexical vars; if the latter, we see if
+ PL_generation matches.
+ 'top' indicates whether we're recursing or at the top level.
+*/
+
+static int
+S_aassign_scan(pTHX_ OP* o, bool rhs, bool top)
+{
+ int flags = 0;
+ bool kid_top = FALSE;
+
+ switch (o->op_type) {
+ case OP_GVSV:
+ return AAS_PKG_SCALAR;
+
+ case OP_PADAV:
+ case OP_PADHV:
+ if (top && (o->op_flags & OPf_REF))
+ return (o->op_private & OPpLVAL_INTRO)
+ ? AAS_MY_AGG : AAS_LEX_AGG;
+ return AAS_DANGEROUS;
+
+ case OP_PADSV:
+ {
+ int comm = S_aassign_padcheck(aTHX_ o, rhs)
+ ? AAS_LEX_SCALAR_COMM : 0;
+ return (o->op_private & OPpLVAL_INTRO)
+ ? (AAS_MY_SCALAR|comm) : (AAS_LEX_SCALAR|comm);
+ }
+
+ case OP_RV2AV:
+ case OP_RV2HV:
+ if (cUNOPx(o)->op_first->op_type != OP_GV)
+ return AAS_DANGEROUS; /* @{expr}, %{expr} */
+ /* @pkg, %pkg */
+ if (top && (o->op_flags & OPf_REF))
+ return AAS_PKG_AGG;
+ return AAS_DANGEROUS;
+
+ case OP_RV2SV:
+ if (cUNOPx(o)->op_first->op_type != OP_GV)
+ return AAS_DANGEROUS; /* ${expr} */
+ return AAS_PKG_SCALAR; /* $pkg */
+
+ case OP_SPLIT:
+ if (cLISTOPo->op_first->op_type == OP_PUSHRE)
+ /* "@foo = split... " optimises away the aassign and stores its
+ * destination array in the OP_PUSHRE that precedes it.
+ * A flattened array is always dangerous.
+ */
+ return AAS_DANGEROUS;
+ break;
+
+ case OP_UNDEF:
+ case OP_PUSHMARK:
+ case OP_STUB:
+ /* these are all no-ops; they don't push a potentially common SV
+ * onto the stack, so they are neither AAS_DANGEROUS nor
+ * AAS_SAFE_SCALAR */
+ return 0;
+
+ case OP_PADRANGE: /* Ignore padrange; checking its siblings is enough */
+ break;
+
+ case OP_NULL:
+ case OP_LIST:
+ /* these do nothing but may have children; but their children
+ * should also be treated as top-level */
+ kid_top = top;
+ break;
+
+ default:
+ if (PL_opargs[o->op_type] & OA_DANGEROUS)
+ return AAS_DANGEROUS;
+
+ if ( (PL_opargs[o->op_type] & OA_TARGLEX)
+ && (o->op_private & OPpTARGET_MY))
+ {
+ return S_aassign_padcheck(aTHX_ o, rhs)
+ ? AAS_LEX_SCALAR_COMM : AAS_LEX_SCALAR;
+ }
+
+ /* if its an unrecognised, non-dangerous op, assume that it
+ * it the cause of at least one safe scalar */
+ flags = AAS_SAFE_SCALAR;
+ break;
+ }
+
+ if (o->op_flags & OPf_KIDS) {
+ OP *kid;
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+ flags |= S_aassign_scan(aTHX_ kid, rhs, kid_top);
+ }
+ return flags;
+}
+
+
/* Check for in place reverse and sort assignments like "@a = reverse @a"
and modify the optree to make them work inplace */
}
break;
- case OP_AASSIGN:
- /* We do the common-vars check here, rather than in newASSIGNOP
- (as formerly), so that all lexical vars that get aliased are
- marked as such before we do the check. */
- /* There can’t be common vars if the lhs is a stub. */
- if (OpSIBLING(cLISTOPx(cBINOPo->op_last)->op_first)
- == cLISTOPx(cBINOPo->op_last)->op_last
- && cLISTOPx(cBINOPo->op_last)->op_last->op_type == OP_STUB)
- {
- o->op_private &=~ OPpASSIGN_COMMON;
- break;
- }
- if (o->op_private & OPpASSIGN_COMMON) {
- /* See the comment before S_aassign_common_vars concerning
- PL_generation sorcery. */
- PL_generation++;
- if (!aassign_common_vars(o))
- o->op_private &=~ OPpASSIGN_COMMON;
- }
- else if (S_aassign_common_vars_aliases_only(aTHX_ o))
- o->op_private |= OPpASSIGN_COMMON;
+ case OP_AASSIGN: {
+ int l, r, lr;
+
+ /* handle common vars detection, e.g. ($a,$b) = ($b,$a).
+ Note that we do this now rather than in newASSIGNOP(),
+ since only by now are aliased lexicals flagged as such
+
+ See the essay "Common vars in list assignment" above for
+ the full details of the rationale behind all the conditions
+ below.
+
+ PL_generation sorcery:
+ To detect whether there are common vars, the global var
+ PL_generation is incremented for each assign op we scan.
+ Then we run through all the lexical variables on the LHS,
+ of the assignment, setting a spare slot in each of them to
+ PL_generation. Then we scan the RHS, and if any lexicals
+ already have that value, we know we've got commonality.
+ Also, if the generation number is already set to
+ PERL_INT_MAX, then the variable is involved in aliasing, so
+ we also have potential commonality in that case.
+ */
+
+ PL_generation++;
+ l = S_aassign_scan(aTHX_ cLISTOPo->op_last, FALSE, 1);/* scan LHS */
+ r = S_aassign_scan(aTHX_ cLISTOPo->op_first, TRUE, 1); /* scan RHS */
+ lr = (l|r);
+
+
+ /* After looking for things which are *always* safe, this main
+ * if/else chain selects primarily based on the type of the
+ * LHS, gradually working its way down from the more dangerous
+ * to the more restrictive and thus safer cases */
+
+ if ( !l /* () = ....; */
+ || !r /* .... = (); */
+ || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
+ || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */
+ /*XXX we could also test for:
+ * LHS contains a single scalar element
+ * RHS contains a single element with no aggregate on LHS
+ */
+ )
+ {
+ NOOP; /* always safe */
+ }
+ else if (l & AAS_DANGEROUS) {
+ /* always dangerous */
+ o->op_private |= OPpASSIGN_COMMON_SCALAR;
+ o->op_private |= OPpASSIGN_COMMON_AGG;
+ }
+ else if (l & (AAS_PKG_SCALAR|AAS_PKG_AGG)) {
+ /* package vars are always dangerous - too many
+ * aliasing possibilities */
+ if (l & AAS_PKG_SCALAR)
+ o->op_private |= OPpASSIGN_COMMON_SCALAR;
+ if (l & AAS_PKG_AGG)
+ o->op_private |= OPpASSIGN_COMMON_AGG;
+ }
+ else if (l & ( AAS_MY_SCALAR|AAS_MY_AGG
+ |AAS_LEX_SCALAR|AAS_LEX_AGG))
+ {
+ /* LHS contains only lexicals and safe ops */
+
+ if (l & (AAS_MY_AGG|AAS_LEX_AGG))
+ o->op_private |= OPpASSIGN_COMMON_AGG;
+
+ if (l & (AAS_MY_SCALAR|AAS_LEX_SCALAR)) {
+ if (lr & AAS_LEX_SCALAR_COMM)
+ o->op_private |= OPpASSIGN_COMMON_SCALAR;
+ else if (r & (AAS_PKG_SCALAR|AAS_PKG_AGG|AAS_DANGEROUS))
+ o->op_private |= OPpASSIGN_COMMON_RC1;
+ }
+ }
break;
+ }
case OP_CUSTOM: {
Perl_cpeep_t cpeep =
#define OPpSORT_INPLACE 0x08
#define OPpTRANS_SQUASH 0x08
#define OPpARG4_MASK 0x0f
+#define OPpASSIGN_COMMON_AGG 0x10
#define OPpCONST_ENTERED 0x10
#define OPpDEREF_AV 0x10
#define OPpEVAL_COPHH 0x10
#define OPpSORT_DESCEND 0x10
#define OPpSUBSTR_REPL_FIRST 0x10
#define OPpTARGET_MY 0x10
+#define OPpASSIGN_COMMON_RC1 0x20
#define OPpDEREF_HV 0x20
#define OPpEARLY_CV 0x20
#define OPpEVAL_RE_REPARSING 0x20
#define OPpLVREF_TYPE 0x30
#define OPpALLOW_FAKE 0x40
#define OPpASSIGN_BACKWARDS 0x40
-#define OPpASSIGN_COMMON 0x40
+#define OPpASSIGN_COMMON_SCALAR 0x40
#define OPpCONST_BARE 0x40
#define OPpCOREARGS_SCALARMOD 0x40
#define OPpENTERSUB_DB 0x40
'B','O','O','L','\0',
'B','O','O','L','?','\0',
'B','Y','T','E','S','\0',
- 'C','O','M','M','O','N','\0',
'C','O','M','P','L','\0',
+ 'C','O','M','_','A','G','G','\0',
+ 'C','O','M','_','R','C','1','\0',
+ 'C','O','M','_','S','C','A','L','A','R','\0',
'C','O','N','S','T','\0',
'C','O','P','H','H','\0',
'C','V','\0',
0, 8, -1,
0, 8, -1,
0, 8, -1,
- 4, -1, 1, 137, 2, 144, 3, 151, -1,
- 4, -1, 0, 495, 1, 26, 2, 264, 3, 83, -1,
+ 4, -1, 1, 157, 2, 164, 3, 171, -1,
+ 4, -1, 0, 515, 1, 26, 2, 284, 3, 103, -1,
};
68, /* aassign */
0, /* chop */
0, /* schop */
- 71, /* chomp */
- 71, /* schomp */
+ 73, /* chomp */
+ 73, /* schomp */
0, /* defined */
0, /* undef */
0, /* study */
0, /* i_postinc */
0, /* postdec */
0, /* i_postdec */
- 73, /* pow */
- 73, /* multiply */
- 73, /* i_multiply */
- 73, /* divide */
- 73, /* i_divide */
- 73, /* modulo */
- 73, /* i_modulo */
- 75, /* repeat */
- 73, /* add */
- 73, /* i_add */
- 73, /* subtract */
- 73, /* i_subtract */
- 73, /* concat */
- 77, /* stringify */
- 73, /* left_shift */
- 73, /* right_shift */
+ 75, /* pow */
+ 75, /* multiply */
+ 75, /* i_multiply */
+ 75, /* divide */
+ 75, /* i_divide */
+ 75, /* modulo */
+ 75, /* i_modulo */
+ 77, /* repeat */
+ 75, /* add */
+ 75, /* i_add */
+ 75, /* subtract */
+ 75, /* i_subtract */
+ 75, /* concat */
+ 79, /* stringify */
+ 75, /* left_shift */
+ 75, /* right_shift */
12, /* lt */
12, /* i_lt */
12, /* gt */
12, /* bit_and */
12, /* bit_xor */
12, /* bit_or */
- 73, /* nbit_and */
- 73, /* nbit_xor */
- 73, /* nbit_or */
+ 75, /* nbit_and */
+ 75, /* nbit_xor */
+ 75, /* nbit_or */
12, /* sbit_and */
12, /* sbit_xor */
12, /* sbit_or */
0, /* i_negate */
0, /* not */
0, /* complement */
- 71, /* ncomplement */
- 71, /* scomplement */
+ 73, /* ncomplement */
+ 73, /* scomplement */
12, /* smartmatch */
- 77, /* atan2 */
- 71, /* sin */
- 71, /* cos */
- 77, /* rand */
- 77, /* srand */
- 71, /* exp */
- 71, /* log */
- 71, /* sqrt */
- 71, /* int */
- 71, /* hex */
- 71, /* oct */
- 71, /* abs */
- 71, /* length */
- 79, /* substr */
- 82, /* vec */
- 77, /* index */
- 77, /* rindex */
+ 79, /* atan2 */
+ 73, /* sin */
+ 73, /* cos */
+ 79, /* rand */
+ 79, /* srand */
+ 73, /* exp */
+ 73, /* log */
+ 73, /* sqrt */
+ 73, /* int */
+ 73, /* hex */
+ 73, /* oct */
+ 73, /* abs */
+ 73, /* length */
+ 81, /* substr */
+ 84, /* vec */
+ 79, /* index */
+ 79, /* rindex */
49, /* sprintf */
49, /* formline */
- 71, /* ord */
- 71, /* chr */
- 77, /* crypt */
+ 73, /* ord */
+ 73, /* chr */
+ 79, /* crypt */
0, /* ucfirst */
0, /* lcfirst */
0, /* uc */
0, /* lc */
0, /* quotemeta */
- 84, /* rv2av */
- 90, /* aelemfast */
- 90, /* aelemfast_lex */
- 91, /* aelem */
- 96, /* aslice */
- 99, /* kvaslice */
+ 86, /* rv2av */
+ 92, /* aelemfast */
+ 92, /* aelemfast_lex */
+ 93, /* aelem */
+ 98, /* aslice */
+ 101, /* kvaslice */
0, /* aeach */
0, /* akeys */
0, /* avalues */
0, /* each */
0, /* values */
40, /* keys */
- 100, /* delete */
- 103, /* exists */
- 105, /* rv2hv */
- 91, /* helem */
- 96, /* hslice */
- 99, /* kvhslice */
- 113, /* multideref */
+ 102, /* delete */
+ 105, /* exists */
+ 107, /* rv2hv */
+ 93, /* helem */
+ 98, /* hslice */
+ 101, /* kvhslice */
+ 115, /* multideref */
49, /* unpack */
49, /* pack */
- 120, /* split */
+ 122, /* split */
49, /* join */
- 122, /* list */
+ 124, /* list */
12, /* lslice */
49, /* anonlist */
49, /* anonhash */
49, /* splice */
- 77, /* push */
+ 79, /* push */
0, /* pop */
0, /* shift */
- 77, /* unshift */
- 124, /* sort */
- 131, /* reverse */
- 133, /* grepstart */
- 133, /* grepwhile */
- 133, /* mapstart */
- 133, /* mapwhile */
+ 79, /* unshift */
+ 126, /* sort */
+ 133, /* reverse */
+ 135, /* grepstart */
+ 135, /* grepwhile */
+ 135, /* mapstart */
+ 135, /* mapwhile */
0, /* range */
- 135, /* flip */
- 135, /* flop */
+ 137, /* flip */
+ 137, /* flop */
0, /* and */
0, /* or */
12, /* xor */
0, /* dor */
- 137, /* cond_expr */
+ 139, /* cond_expr */
0, /* andassign */
0, /* orassign */
0, /* dorassign */
0, /* method */
- 139, /* entersub */
- 146, /* leavesub */
- 146, /* leavesublv */
- 148, /* caller */
+ 141, /* entersub */
+ 148, /* leavesub */
+ 148, /* leavesublv */
+ 150, /* caller */
49, /* warn */
49, /* die */
49, /* reset */
-1, /* lineseq */
- 150, /* nextstate */
- 150, /* dbstate */
+ 152, /* nextstate */
+ 152, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 151, /* leave */
+ 153, /* leave */
-1, /* scope */
- 153, /* enteriter */
- 157, /* iter */
+ 155, /* enteriter */
+ 159, /* iter */
-1, /* enterloop */
- 158, /* leaveloop */
+ 160, /* leaveloop */
-1, /* return */
- 160, /* last */
- 160, /* next */
- 160, /* redo */
- 160, /* dump */
- 160, /* goto */
+ 162, /* last */
+ 162, /* next */
+ 162, /* redo */
+ 162, /* dump */
+ 162, /* goto */
49, /* exit */
0, /* method_named */
0, /* method_super */
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 162, /* open */
+ 164, /* open */
49, /* close */
49, /* pipe_op */
49, /* fileno */
49, /* getc */
49, /* read */
49, /* enterwrite */
- 146, /* leavewrite */
+ 148, /* leavewrite */
-1, /* prtf */
-1, /* print */
-1, /* say */
49, /* truncate */
49, /* fcntl */
49, /* ioctl */
- 77, /* flock */
+ 79, /* flock */
49, /* send */
49, /* recv */
49, /* socket */
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 167, /* ftrread */
- 167, /* ftrwrite */
- 167, /* ftrexec */
- 167, /* fteread */
- 167, /* ftewrite */
- 167, /* fteexec */
- 172, /* ftis */
- 172, /* ftsize */
- 172, /* ftmtime */
- 172, /* ftatime */
- 172, /* ftctime */
- 172, /* ftrowned */
- 172, /* fteowned */
- 172, /* ftzero */
- 172, /* ftsock */
- 172, /* ftchr */
- 172, /* ftblk */
- 172, /* ftfile */
- 172, /* ftdir */
- 172, /* ftpipe */
- 172, /* ftsuid */
- 172, /* ftsgid */
- 172, /* ftsvtx */
- 172, /* ftlink */
- 172, /* fttty */
- 172, /* fttext */
- 172, /* ftbinary */
- 77, /* chdir */
- 77, /* chown */
- 71, /* chroot */
- 77, /* unlink */
- 77, /* chmod */
- 77, /* utime */
- 77, /* rename */
- 77, /* link */
- 77, /* symlink */
+ 169, /* ftrread */
+ 169, /* ftrwrite */
+ 169, /* ftrexec */
+ 169, /* fteread */
+ 169, /* ftewrite */
+ 169, /* fteexec */
+ 174, /* ftis */
+ 174, /* ftsize */
+ 174, /* ftmtime */
+ 174, /* ftatime */
+ 174, /* ftctime */
+ 174, /* ftrowned */
+ 174, /* fteowned */
+ 174, /* ftzero */
+ 174, /* ftsock */
+ 174, /* ftchr */
+ 174, /* ftblk */
+ 174, /* ftfile */
+ 174, /* ftdir */
+ 174, /* ftpipe */
+ 174, /* ftsuid */
+ 174, /* ftsgid */
+ 174, /* ftsvtx */
+ 174, /* ftlink */
+ 174, /* fttty */
+ 174, /* fttext */
+ 174, /* ftbinary */
+ 79, /* chdir */
+ 79, /* chown */
+ 73, /* chroot */
+ 79, /* unlink */
+ 79, /* chmod */
+ 79, /* utime */
+ 79, /* rename */
+ 79, /* link */
+ 79, /* symlink */
0, /* readlink */
- 77, /* mkdir */
- 71, /* rmdir */
+ 79, /* mkdir */
+ 73, /* rmdir */
49, /* open_dir */
0, /* readdir */
0, /* telldir */
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 176, /* wait */
- 77, /* waitpid */
- 77, /* system */
- 77, /* exec */
- 77, /* kill */
- 176, /* getppid */
- 77, /* getpgrp */
- 77, /* setpgrp */
- 77, /* getpriority */
- 77, /* setpriority */
- 176, /* time */
+ 178, /* wait */
+ 79, /* waitpid */
+ 79, /* system */
+ 79, /* exec */
+ 79, /* kill */
+ 178, /* getppid */
+ 79, /* getpgrp */
+ 79, /* setpgrp */
+ 79, /* getpriority */
+ 79, /* setpriority */
+ 178, /* time */
-1, /* tms */
0, /* localtime */
49, /* gmtime */
0, /* alarm */
- 77, /* sleep */
+ 79, /* sleep */
49, /* shmget */
49, /* shmctl */
49, /* shmread */
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 177, /* entereval */
- 146, /* leaveeval */
+ 179, /* entereval */
+ 148, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
0, /* ghbyname */
0, /* lock */
0, /* once */
-1, /* custom */
- 183, /* coreargs */
+ 185, /* coreargs */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 187, /* padrange */
- 189, /* refassign */
- 195, /* lvref */
- 201, /* lvrefslice */
- 202, /* lvavref */
+ 189, /* padrange */
+ 191, /* refassign */
+ 197, /* lvref */
+ 203, /* lvrefslice */
+ 204, /* lvavref */
0, /* anonconst */
};
EXTCONST U16 PL_op_private_bitdefs[] = {
0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
- 0x29dc, 0x3bd9, /* pushmark */
+ 0x2c5c, 0x3e59, /* pushmark */
0x00bd, /* wantarray, runcv */
- 0x03b8, 0x1570, 0x3c8c, 0x3748, 0x2da5, /* const */
- 0x29dc, 0x2ef9, /* gvsv */
- 0x13d5, /* gv */
+ 0x03b8, 0x17f0, 0x3f0c, 0x39c8, 0x3025, /* const */
+ 0x2c5c, 0x3179, /* gvsv */
+ 0x1655, /* gv */
0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
- 0x29dc, 0x3bd8, 0x0257, /* padsv */
- 0x29dc, 0x3bd8, 0x2acc, 0x38c9, /* padav */
- 0x29dc, 0x3bd8, 0x0534, 0x05d0, 0x2acc, 0x38c9, /* padhv */
- 0x3698, 0x3ef1, /* pushre, match, qr, subst */
- 0x29dc, 0x1758, 0x0256, 0x2acc, 0x2cc8, 0x3c84, 0x0003, /* rv2gv */
- 0x29dc, 0x2ef8, 0x0256, 0x3c84, 0x0003, /* rv2sv */
- 0x2acc, 0x0003, /* av2arylen, pos, keys */
- 0x2c3c, 0x0b98, 0x08f4, 0x028c, 0x3e48, 0x3c84, 0x0003, /* rv2cv */
+ 0x2c5c, 0x3e58, 0x0257, /* padsv */
+ 0x2c5c, 0x3e58, 0x2d4c, 0x3b49, /* padav */
+ 0x2c5c, 0x3e58, 0x0534, 0x05d0, 0x2d4c, 0x3b49, /* padhv */
+ 0x3918, 0x4171, /* pushre, match, qr, subst */
+ 0x2c5c, 0x19d8, 0x0256, 0x2d4c, 0x2f48, 0x3f04, 0x0003, /* rv2gv */
+ 0x2c5c, 0x3178, 0x0256, 0x3f04, 0x0003, /* rv2sv */
+ 0x2d4c, 0x0003, /* av2arylen, pos, keys */
+ 0x2ebc, 0x0e18, 0x0b74, 0x028c, 0x40c8, 0x3f04, 0x0003, /* rv2cv */
0x012f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
- 0x30dc, 0x2ff8, 0x24b4, 0x23f0, 0x0003, /* backtick */
- 0x3698, 0x0003, /* substcont */
- 0x0c9c, 0x1dd8, 0x0834, 0x3ef0, 0x3a0c, 0x2168, 0x01e4, 0x0141, /* trans, transr */
- 0x0adc, 0x0458, 0x0067, /* sassign */
- 0x0758, 0x2acc, 0x0067, /* aassign */
- 0x3ef0, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */
- 0x3ef0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
- 0x1058, 0x0067, /* repeat */
- 0x3ef0, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
- 0x33f0, 0x2acc, 0x00cb, /* substr */
- 0x2acc, 0x0067, /* vec */
- 0x29dc, 0x2ef8, 0x2acc, 0x38c8, 0x3c84, 0x0003, /* rv2av */
+ 0x335c, 0x3278, 0x2734, 0x2670, 0x0003, /* backtick */
+ 0x3918, 0x0003, /* substcont */
+ 0x0f1c, 0x2058, 0x0754, 0x4170, 0x3c8c, 0x23e8, 0x01e4, 0x0141, /* trans, transr */
+ 0x0d5c, 0x0458, 0x0067, /* sassign */
+ 0x0a18, 0x0914, 0x0810, 0x2d4c, 0x0067, /* aassign */
+ 0x4170, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */
+ 0x4170, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
+ 0x12d8, 0x0067, /* repeat */
+ 0x4170, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
+ 0x3670, 0x2d4c, 0x00cb, /* substr */
+ 0x2d4c, 0x0067, /* vec */
+ 0x2c5c, 0x3178, 0x2d4c, 0x3b48, 0x3f04, 0x0003, /* rv2av */
0x01ff, /* aelemfast, aelemfast_lex */
- 0x29dc, 0x28d8, 0x0256, 0x2acc, 0x0067, /* aelem, helem */
- 0x29dc, 0x2acc, 0x38c9, /* aslice, hslice */
- 0x2acd, /* kvaslice, kvhslice */
- 0x29dc, 0x3818, 0x0003, /* delete */
- 0x3d78, 0x0003, /* exists */
- 0x29dc, 0x2ef8, 0x0534, 0x05d0, 0x2acc, 0x38c8, 0x3c84, 0x0003, /* rv2hv */
- 0x29dc, 0x28d8, 0x0d14, 0x1670, 0x2acc, 0x3c84, 0x0003, /* multideref */
- 0x223c, 0x2ef9, /* split */
- 0x29dc, 0x1e99, /* list */
- 0x3af8, 0x3194, 0x0fb0, 0x254c, 0x34e8, 0x2644, 0x2e61, /* sort */
- 0x254c, 0x0003, /* reverse */
- 0x1cc4, 0x0003, /* grepstart, grepwhile, mapstart, mapwhile */
- 0x2778, 0x0003, /* flip, flop */
- 0x29dc, 0x0003, /* cond_expr */
- 0x29dc, 0x0b98, 0x0256, 0x028c, 0x3e48, 0x3c84, 0x2301, /* entersub */
- 0x3258, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+ 0x2c5c, 0x2b58, 0x0256, 0x2d4c, 0x0067, /* aelem, helem */
+ 0x2c5c, 0x2d4c, 0x3b49, /* aslice, hslice */
+ 0x2d4d, /* kvaslice, kvhslice */
+ 0x2c5c, 0x3a98, 0x0003, /* delete */
+ 0x3ff8, 0x0003, /* exists */
+ 0x2c5c, 0x3178, 0x0534, 0x05d0, 0x2d4c, 0x3b48, 0x3f04, 0x0003, /* rv2hv */
+ 0x2c5c, 0x2b58, 0x0f94, 0x18f0, 0x2d4c, 0x3f04, 0x0003, /* multideref */
+ 0x24bc, 0x3179, /* split */
+ 0x2c5c, 0x2119, /* list */
+ 0x3d78, 0x3414, 0x1230, 0x27cc, 0x3768, 0x28c4, 0x30e1, /* sort */
+ 0x27cc, 0x0003, /* reverse */
+ 0x1f44, 0x0003, /* grepstart, grepwhile, mapstart, mapwhile */
+ 0x29f8, 0x0003, /* flip, flop */
+ 0x2c5c, 0x0003, /* cond_expr */
+ 0x2c5c, 0x0e18, 0x0256, 0x028c, 0x40c8, 0x3f04, 0x2581, /* entersub */
+ 0x34d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
0x00bc, 0x012f, /* caller */
- 0x2075, /* nextstate, dbstate */
- 0x287c, 0x3259, /* leave */
- 0x29dc, 0x2ef8, 0x0c0c, 0x3569, /* enteriter */
- 0x3569, /* iter */
- 0x287c, 0x0067, /* leaveloop */
- 0x405c, 0x0003, /* last, next, redo, dump, goto */
- 0x30dc, 0x2ff8, 0x24b4, 0x23f0, 0x012f, /* open */
- 0x1910, 0x1b6c, 0x1a28, 0x17e4, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
- 0x1910, 0x1b6c, 0x1a28, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
- 0x3ef1, /* wait, getppid, time */
- 0x32f4, 0x09b0, 0x068c, 0x3fc8, 0x1f84, 0x0003, /* entereval */
- 0x2b9c, 0x0018, 0x0ec4, 0x0de1, /* coreargs */
- 0x29dc, 0x019b, /* padrange */
- 0x29dc, 0x3bd8, 0x0376, 0x26cc, 0x14c8, 0x0067, /* refassign */
- 0x29dc, 0x3bd8, 0x0376, 0x26cc, 0x14c8, 0x0003, /* lvref */
- 0x29dd, /* lvrefslice */
- 0x29dc, 0x3bd8, 0x0003, /* lvavref */
+ 0x22f5, /* nextstate, dbstate */
+ 0x2afc, 0x34d9, /* leave */
+ 0x2c5c, 0x3178, 0x0e8c, 0x37e9, /* enteriter */
+ 0x37e9, /* iter */
+ 0x2afc, 0x0067, /* leaveloop */
+ 0x42dc, 0x0003, /* last, next, redo, dump, goto */
+ 0x335c, 0x3278, 0x2734, 0x2670, 0x012f, /* open */
+ 0x1b90, 0x1dec, 0x1ca8, 0x1a64, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
+ 0x1b90, 0x1dec, 0x1ca8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
+ 0x4171, /* wait, getppid, time */
+ 0x3574, 0x0c30, 0x068c, 0x4248, 0x2204, 0x0003, /* entereval */
+ 0x2e1c, 0x0018, 0x1144, 0x1061, /* coreargs */
+ 0x2c5c, 0x019b, /* padrange */
+ 0x2c5c, 0x3e58, 0x0376, 0x294c, 0x1748, 0x0067, /* refassign */
+ 0x2c5c, 0x3e58, 0x0376, 0x294c, 0x1748, 0x0003, /* lvref */
+ 0x2c5d, /* lvrefslice */
+ 0x2c5c, 0x3e58, 0x0003, /* lvavref */
};
/* TRANS */ (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTARGET_MY|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE),
/* TRANSR */ (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTARGET_MY|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE),
/* SASSIGN */ (OPpARG2_MASK|OPpASSIGN_BACKWARDS|OPpASSIGN_CV_TO_GV),
- /* AASSIGN */ (OPpARG2_MASK|OPpMAYBE_LVSUB|OPpASSIGN_COMMON),
+ /* AASSIGN */ (OPpARG2_MASK|OPpMAYBE_LVSUB|OPpASSIGN_COMMON_AGG|OPpASSIGN_COMMON_RC1|OPpASSIGN_COMMON_SCALAR),
/* CHOP */ (OPpARG1_MASK),
/* SCHOP */ (OPpARG1_MASK),
/* CHOMP */ (OPpARG1_MASK|OPpTARGET_MY),
}
}
+
+/* Do a mark and sweep with the SVf_BREAK flag to detect elements which
+ * are common to both the LHS and RHS of an aassign, and replace them
+ * with copies. All these copies are made before the actual list assign is
+ * done.
+ *
+ * For example in ($a,$b) = ($b,$a), assigning the value of the first RHS
+ * element ($b) to the first LH element ($a), modifies $a; when the
+ * second assignment is done, the second RH element now has the wrong
+ * value. So we initially replace the RHS with ($b, mortalcopy($a)).
+ * Note that we don't need to make a mortal copy of $b.
+ *
+ * The algorithm below works by, for every RHS element, mark the
+ * corresponding LHS target element with SVf_BREAK. Then if the RHS
+ * element is found with SVf_BREAK set, it means it would have been
+ * modified, so make a copy.
+ * Note that by scanning both LHS and RHS in lockstep, we avoid
+ * unnecessary copies (like $b above) compared with a naive
+ * "mark all LHS; copy all marked RHS; unmark all LHS".
+ *
+ * If the LHS element is a 'my' declaration' and has a refcount of 1, then
+ * it can't be common and can be skipped.
+ */
+
+PERL_STATIC_INLINE void
+S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
+ SV **firstrelem, SV **lastrelem)
+{
+ dVAR;
+ SV **relem;
+ SV **lelem;
+ SSize_t lcount = lastlelem - firstlelem + 1;
+ bool marked = FALSE; /* have we marked any LHS with SVf_BREAK ? */
+ bool const do_rc1 = cBOOL(PL_op->op_private & OPpASSIGN_COMMON_RC1);
+
+ assert(!PL_in_clean_all); /* SVf_BREAK not already in use */
+ assert(firstlelem < lastlelem); /* at least 2 LH elements */
+ assert(firstrelem < lastrelem); /* at least 2 RH elements */
+
+ /* we never have to copy the first RH element; it can't be corrupted
+ * by assigning something to the corresponding first LH element.
+ * So this scan does in a loop: mark LHS[N]; test RHS[N+1]
+ */
+ firstrelem++;
+
+ lelem = firstlelem;
+ relem = firstrelem;
+
+ for (; relem <= lastrelem; relem++) {
+ SV *svr;
+
+ /* mark next LH element */
+
+ if (--lcount >= 0) {
+ SV *svl = *lelem++;
+
+ if (UNLIKELY(!svl)) {/* skip AV alias marker */
+ assert (lelem <= lastlelem);
+ svl = *lelem++;
+ lcount--;
+ }
+
+ assert(svl);
+ if (SvTYPE(svl) == SVt_PVAV || SvTYPE(svl) == SVt_PVHV) {
+ if (!marked)
+ return;
+ /* this LH element will consume all further args;
+ * no need to mark any further LH elements (if any).
+ * But we still need to scan any remaining RHS elements;
+ * set lcount negative to distinguish from lcount == 0,
+ * so the loop condition continues being true
+ */
+ lcount = -1;
+ lelem--; /* no need to unmark this element */
+ }
+ else if (!(do_rc1 && SvREFCNT(svl) == 1) && svl != &PL_sv_undef) {
+ assert(!SvIMMORTAL(svl));
+ SvFLAGS(svl) |= SVf_BREAK;
+ marked = TRUE;
+ }
+ else if (!marked) {
+ /* don't check RH element if no SVf_BREAK flags set yet */
+ if (!lcount)
+ break;
+ continue;
+ }
+ }
+
+ /* see if corresponding RH element needs copying */
+
+ assert(marked);
+ svr = *relem;
+ assert(svr);
+
+ if (UNLIKELY(SvFLAGS(svr) & SVf_BREAK)) {
+
+ TAINT_NOT; /* Each item is independent */
+
+ /* Dear TODO test in t/op/sort.t, I love you.
+ (It's relying on a panic, not a "semi-panic" from newSVsv()
+ and then an assertion failure below.) */
+ if (UNLIKELY(SvIS_FREED(svr))) {
+ Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
+ (void*)svr);
+ }
+ /* avoid break flag while copying; otherwise COW etc
+ * disabled... */
+ SvFLAGS(svr) &= ~SVf_BREAK;
+ /* Not newSVsv(), as it does not allow copy-on-write,
+ resulting in wasteful copies. We need a second copy of
+ a temp here, hence the SV_NOSTEAL. */
+ *relem = sv_mortalcopy_flags(svr,
+ SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
+ /* ... but restore afterwards in case it's needed again,
+ * e.g. ($a,$b,$c) = (1,$a,$a)
+ */
+ SvFLAGS(svr) |= SVf_BREAK;
+ }
+
+ if (!lcount)
+ break;
+ }
+
+ if (!marked)
+ return;
+
+ /*unmark LHS */
+
+ while (lelem > firstlelem) {
+ SV * const svl = *(--lelem);
+ if (svl)
+ SvFLAGS(svl) &= ~SVf_BREAK;
+ }
+}
+
+
+
PP(pp_aassign)
{
dVAR; dSP;
HV *hash;
SSize_t i;
int magic;
- U32 lval = 0;
+ U32 lval;
PL_delaymagic = DM_DELAY; /* catch simultaneous items */
- gimme = GIMME_V;
- if (gimme == G_ARRAY)
- lval = PL_op->op_flags & OPf_MOD || LVRET;
/* If there's a common identifier on both sides we have to take
* special care that assigning the identifier on the left doesn't
* clobber a value on the right that's used later in the list.
- * Don't bother if LHS is just an empty hash or array.
*/
- if ( (PL_op->op_private & OPpASSIGN_COMMON || PL_sawalias)
- && (
- firstlelem != lastlelem
- || ! ((sv = *firstlelem))
- || SvMAGICAL(sv)
- || ! (SvTYPE(sv) == SVt_PVAV || SvTYPE(sv) == SVt_PVHV)
- || (SvTYPE(sv) == SVt_PVAV && AvFILL((AV*)sv) != -1)
- || (SvTYPE(sv) == SVt_PVHV && HvUSEDKEYS((HV*)sv) != 0)
- )
+ if ( (PL_op->op_private & (OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1))
+ /* at least 2 LH and RH elements, or commonality isn't an issue */
+ && (firstlelem < lastlelem && firstrelem < lastrelem)
) {
- EXTEND_MORTAL(lastrelem - firstrelem + 1);
- for (relem = firstrelem; relem <= lastrelem; relem++) {
- if (LIKELY((sv = *relem))) {
- TAINT_NOT; /* Each item is independent */
-
- /* Dear TODO test in t/op/sort.t, I love you.
- (It's relying on a panic, not a "semi-panic" from newSVsv()
- and then an assertion failure below.) */
- if (UNLIKELY(SvIS_FREED(sv))) {
- Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
- (void*)sv);
- }
- /* Not newSVsv(), as it does not allow copy-on-write,
- resulting in wasteful copies. We need a second copy of
- a temp here, hence the SV_NOSTEAL. */
- *relem = sv_mortalcopy_flags(sv,SV_GMAGIC|SV_DO_COW_SVSETSV
- |SV_NOSTEAL);
- }
- }
+ if (PL_op->op_private & OPpASSIGN_COMMON_RC1) {
+ /* skip the scan if all scalars have a ref count of 1 */
+ for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
+ sv = *lelem;
+ if (!sv || SvREFCNT(sv) == 1)
+ continue;
+ if (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVAV)
+ goto do_scan;
+ break;
+ }
+ }
+ else {
+ do_scan:
+ S_aassign_copy_common(aTHX_
+ firstlelem, lastlelem, firstrelem, lastrelem);
+ }
}
+ gimme = GIMME_V;
+ lval = (gimme == G_ARRAY) ? (PL_op->op_flags & OPf_MOD || LVRET) : 0;
+
relem = firstrelem;
lelem = firstlelem;
ary = NULL;
ASSUME(SvTYPE(sv) == SVt_PVAV);
}
switch (SvTYPE(sv)) {
- case SVt_PVAV:
+ case SVt_PVAV: {
+ bool already_copied = FALSE;
ary = MUTABLE_AV(sv);
magic = SvMAGICAL(ary) != 0;
ENTER;
SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
- av_clear(ary);
+
+ /* We need to clear ary. The is a danger that if we do this,
+ * elements on the RHS may be prematurely freed, e.g.
+ * @a = ($a[0]);
+ * In the case of possible commonality, make a copy of each
+ * RHS SV *before* clearing the array, and add a reference
+ * from the tmps stack, so that it doesn't leak on death.
+ * Otherwise, make a copy of each RHS SV only as we're storing
+ * it into the array - that way we don't have to worry about
+ * it being leaked if we die, but don't incur the cost of
+ * mortalising everything.
+ */
+
+ if ( (PL_op->op_private & OPpASSIGN_COMMON_AGG)
+ && (relem <= lastrelem)
+ && (magic || AvFILL(ary) != -1))
+ {
+ SV **svp;
+ EXTEND_MORTAL(lastrelem - relem + 1);
+ for (svp = relem; svp <= lastrelem; svp++) {
+ *svp = sv_mortalcopy_flags(*svp,
+ SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
+ TAINT_NOT;
+ }
+ already_copied = TRUE;
+ }
+
+ av_clear(ary);
av_extend(ary, lastrelem - relem);
i = 0;
while (relem <= lastrelem) { /* gobble up all the rest */
SV **didstore;
- if (LIKELY(*relem))
- SvGETMAGIC(*relem); /* before newSV, in case it dies */
if (LIKELY(!alias)) {
- sv = newSV(0);
- sv_setsv_nomg(sv, *relem);
- *relem = sv;
+ if (already_copied)
+ sv = *relem;
+ else {
+ if (LIKELY(*relem))
+ /* before newSV, in case it dies */
+ SvGETMAGIC(*relem);
+ sv = newSV(0);
+ sv_setsv_nomg(sv, *relem);
+ *relem = sv;
+ }
}
else {
+ if (!already_copied)
+ SvGETMAGIC(*relem);
if (!SvROK(*relem))
DIE(aTHX_ "Assigned value is not a reference");
if (SvTYPE(SvRV(*relem)) > SVt_PVLV)
/* diag_listed_as: Assigned value is not %s reference */
DIE(aTHX_
"Assigned value is not a SCALAR reference");
- if (lval)
+ if (lval && !already_copied)
*relem = sv_mortalcopy(*relem);
/* XXX else check for weak refs? */
sv = SvREFCNT_inc_simple_NN(SvRV(*relem));
}
relem++;
+ if (already_copied)
+ SvREFCNT_inc_simple_NN(sv); /* undo mortal free */
didstore = av_store(ary,i++,sv);
if (magic) {
if (!didstore)
SvSETMAGIC(MUTABLE_SV(ary));
LEAVE;
break;
+ }
+
case SVt_PVHV: { /* normal hash */
SV *tmpstr;
int odd;
int duplicates = 0;
SV** topelem = relem;
SV **firsthashrelem = relem;
+ bool already_copied = FALSE;
hash = MUTABLE_HV(sv);
magic = SvMAGICAL(hash) != 0;
ENTER;
SAVEFREESV(SvREFCNT_inc_simple_NN(sv));
+
+ /* We need to clear hash. The is a danger that if we do this,
+ * elements on the RHS may be prematurely freed, e.g.
+ * %h = (foo => $h{bar});
+ * In the case of possible commonality, make a copy of each
+ * RHS SV *before* clearing the hash, and add a reference
+ * from the tmps stack, so that it doesn't leak on death.
+ */
+
+ if ( (PL_op->op_private & OPpASSIGN_COMMON_AGG)
+ && (relem <= lastrelem)
+ && (magic || HvUSEDKEYS(hash)))
+ {
+ SV **svp;
+ EXTEND_MORTAL(lastrelem - relem + 1);
+ for (svp = relem; svp <= lastrelem; svp++) {
+ *svp = sv_mortalcopy_flags(*svp,
+ SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL);
+ TAINT_NOT;
+ }
+ already_copied = TRUE;
+ }
+
hv_clear(hash);
+
while (LIKELY(relem < lastrelem+odd)) { /* gobble up all the rest */
HE *didstore;
assert(*relem);
to avoid having the next op modify our rhs. Copy
it also if it is gmagical, lest it make the
hv_store_ent call below croak, leaking the value. */
- sv = lval || SvGMAGICAL(*relem)
+ sv = (lval || SvGMAGICAL(*relem)) && !already_copied
? sv_mortalcopy(*relem)
: *relem;
relem++;
assert(*relem);
- SvGETMAGIC(*relem);
- tmpstr = newSV(0);
- sv_setsv_nomg(tmpstr,*relem++); /* value */
+ if (already_copied)
+ tmpstr = *relem++;
+ else {
+ SvGETMAGIC(*relem);
+ tmpstr = newSV(0);
+ sv_setsv_nomg(tmpstr,*relem++); /* value */
+ }
+
if (gimme == G_ARRAY) {
if (hv_exists_ent(hash, sv, 0))
/* key overwrites an existing entry */
*topelem++ = tmpstr;
}
}
+ if (already_copied)
+ SvREFCNT_inc_simple_NN(tmpstr); /* undo mortal free */
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
if (!didstore) sv_2mortal(tmpstr);
assert(stash)
#endif
#if defined(PERL_IN_OP_C)
-PERL_STATIC_INLINE bool S_aassign_common_vars(pTHX_ OP* o);
STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs);
#define PERL_ARGS_ASSERT_APPLY_ATTRS \
assert(stash); assert(target)
addbits($_, 6 => qw(OPpPAD_STATE STATE)) for qw(padav padhv padsv lvavref
lvref refassign pushmark);
+# NB: both sassign and aassign use the 'OPpASSIGN' naming convention
+# for their private flags
+# there *may* be common scalar items on both sides of a list assign:
+# run-time checking will be needed.
+addbits('aassign', 6 => qw(OPpASSIGN_COMMON_SCALAR COM_SCALAR));
+#
+# as above, but it's possible to check for non-commonality with just
+# a SvREFCNT(lhs) == 1 test for each lhs element
+addbits('aassign', 5 => qw(OPpASSIGN_COMMON_RC1 COM_RC1));
+
+# run-time checking is required for an aggregate on the LHS
+addbits('aassign', 4 => qw(OPpASSIGN_COMMON_AGG COM_AGG));
-addbits('aassign', 6 => qw(OPpASSIGN_COMMON COMMON));
+# NB: both sassign and aassign use the 'OPpASSIGN' naming convention
+# for their private flags
addbits('sassign',
6 => qw(OPpASSIGN_BACKWARDS BKWARD), # Left & right switched
#define SVf_BREAK 0x04000000 /* refcnt is artificially low - used by
SVs in final arena cleanup.
Set in S_regtry on PL_reg_curpm, so that
- perl_destruct will skip it. */
+ perl_destruct will skip it.
+ Used for mark and sweep by OP_AASSIGN
+ */
#define SVf_READONLY 0x08000000 /* may not be modified */
--- /dev/null
+#!./perl -w
+
+# Some miscellaneous checks for the list assignment operator, OP_AASSIGN.
+#
+# This file was only added in 2015; before then, such tests were
+# typically in various other random places like op/array.t. This test file
+# doesn't therefore attempt to be comprehensive; it merely provides a
+# central place to new put additional tests, especially those related to
+# the trickiness of commonality, e.g. ($a,$b) = ($b,$a).
+#
+# In particular, it's testing the flags
+# OPpASSIGN_COMMON_SCALAR
+# OPpASSIGN_COMMON_RC1
+# OPpASSIGN_COMMON_AGG
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+use warnings;
+use strict;
+
+# general purpose package vars
+
+our $pkg_scalar;
+our @pkg_array;
+our %pkg_hash;
+
+sub f_ret_14 { return 1..4 }
+
+# stringify a hash ref
+
+sub sh {
+ my $rh = $_[0];
+ join ',', map "$_:$rh->{$_}", sort keys %$rh;
+}
+
+
+# where the RHS has surplus elements
+
+{
+ my ($a,$b);
+ ($a,$b) = f_ret_14();
+ is("$a:$b", "1:2", "surplus");
+}
+
+# common with slices
+
+{
+ my @a = (1,2);
+ @a[0,1] = @a[1,0];
+ is("$a[0]:$a[1]", "2:1", "lex array slice");
+}
+
+# package alias
+
+{
+ my ($a, $b) = 1..2;
+ for $pkg_scalar ($a) {
+ ($pkg_scalar, $b) = (3, $a);
+ is($pkg_scalar, 3, "package alias pkg");
+ is("$a:$b", "3:1", "package alias a:b");
+ }
+}
+
+# my array/hash populated via closure
+
+{
+ my $ra = f1();
+ my ($x, @a) = @$ra;
+ sub f1 { $x = 1; @a = 2..4; \@a }
+ is($x, 2, "my: array closure x");
+ is("@a", "3 4", "my: array closure a");
+
+ my $rh = f2();
+ my ($k, $v, %h) = (d => 4, %$rh, e => 6);
+ sub f2 { $k = 'a'; $v = 1; %h = qw(b 2 c 3); \%h }
+ is("$k:$v", "d:4", "my: hash closure k:v");
+ is(sh(\%h), "b:2,c:3,e:6", "my: hash closure h");
+}
+
+
+# various shared element scenarios within a my (...)
+
+{
+ my ($x,$y) = f3(); # $x and $y on both sides
+ sub f3 : lvalue { ($x,$y) = (1,2); $y, $x }
+ is ("$x:$y", "2:1", "my: scalar and lvalue sub");
+}
+
+{
+ my $ra = f4();
+ my @a = @$ra; # elements of @a on both sides
+ sub f4 { @a = 1..4; \@a }
+ is("@a", "1 2 3 4", "my: array and elements");
+}
+
+{
+ my $rh = f5();
+ my %h = %$rh; # elements of %h on both sides
+ sub f5 { %h = qw(a 1 b 2 c 3); \%h }
+ is(sh(\%h), "a:1,b:2,c:3", "my: hash and elements");
+}
+
+{
+ f6();
+ our $xalias6;
+ my ($x, $y) = (2, $xalias6);
+ sub f6 { $x = 1; *xalias6 = \$x; }
+ is ("$x:$y", "2:1", "my: pkg var aliased to lexical");
+}
+
+
+{
+ my @a;
+ f7();
+ my ($x,$y) = @a;
+ is ("$x:$y", "2:1", "my: lex array elements aliased");
+
+ sub f7 {
+ ($x, $y) = (1,2);
+ use feature 'refaliasing';
+ no warnings 'experimental';
+ \($a[0], $a[1]) = \($y,$x);
+ }
+}
+
+{
+ @pkg_array = ();
+ f8();
+ my ($x,$y) = @pkg_array;
+ is ("$x:$y", "2:1", "my: pkg array elements aliased");
+
+ sub f8 {
+ ($x, $y) = (1,2);
+ use feature 'refaliasing';
+ no warnings 'experimental';
+ \($pkg_array[0], $pkg_array[1]) = \($y,$x);
+ }
+}
+
+{
+ f9();
+ my ($x,$y) = f9();
+ is ("$x:$y", "2:1", "my: pkg scalar alias");
+
+ our $xalias9;
+ sub f9 : lvalue {
+ ($x, $y) = (1,2);
+ *xalias9 = \$x;
+ $y, $xalias9;
+ }
+}
+
+{
+ use feature 'refaliasing';
+ no warnings 'experimental';
+
+ f10();
+ our $pkg10;
+ \(my $lex) = \$pkg10;
+ my @a = ($lex,3); # equivalent to ($a[0],3)
+ is("@a", "1 3", "my: lex alias of array alement");
+
+ sub f10 {
+ @a = (1,2);
+ \$pkg10 = \$a[0];
+ }
+
+}
+
+{
+ use feature 'refaliasing';
+ no warnings 'experimental';
+
+ f11();
+ my @b;
+ my @a = (@b);
+ is("@a", "2 1", "my: lex alias of array alements");
+
+ sub f11 {
+ @a = (1,2);
+ \$b[0] = \$a[1];
+ \$b[1] = \$a[0];
+ }
+}
+
+# package aliasing
+
+{
+ my ($x, $y) = (1,2);
+
+ for $pkg_scalar ($x) {
+ ($pkg_scalar, $y) = (3, $x);
+ is("$pkg_scalar,$y", "3,1", "package scalar aliased");
+ }
+}
+
+# lvalue subs on LHS
+
+{
+ my @a;
+ sub f12 : lvalue { @a }
+ (f12()) = 1..3;
+ is("@a", "1 2 3", "lvalue sub on RHS returns array");
+}
+
+{
+ my ($x,$y);
+ sub f13 : lvalue { $x,$y }
+ (f13()) = 1..3;
+ is("$x:$y", "1:2", "lvalue sub on RHS returns scalars");
+}
+
+
+# package shared scalar vars
+
+{
+ our $pkg14a = 1;
+ our $pkg14b = 2;
+ ($pkg14a,$pkg14b) = ($pkg14b,$pkg14a);
+ is("$pkg14a:$pkg14b", "2:1", "shared package scalars");
+}
+
+# lexical shared scalar vars
+
+{
+ my $a = 1;
+ my $b = 2;
+ ($a,$b) = ($b,$a);
+ is("$a:$b", "2:1", "shared lexical scalars");
+}
+
+
+# lexical nested array elem swap
+
+{
+ my @a;
+ $a[0][0] = 1;
+ $a[0][1] = 2;
+ ($a[0][0],$a[0][1]) = ($a[0][1],$a[0][0]);
+ is("$a[0][0]:$a[0][1]", "2:1", "lexical nested array elem swap");
+}
+
+# package nested array elem swap
+
+{
+ our @a15;
+ $a15[0][0] = 1;
+ $a15[0][1] = 2;
+ ($a15[0][0],$a15[0][1]) = ($a15[0][1],$a15[0][0]);
+ is("$a15[0][0]:$a15[0][1]", "2:1", "package nested array elem swap");
+}
+
+# surplus RHS junk
+#
+{
+ our ($a16, $b16);
+ ($a16, undef, $b16) = 1..30;
+ is("$a16:$b16", "1:3", "surplus RHS junk");
+}
+
+done_testing();
require './test.pl';
}
-plan (172);
+plan (173);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
for(scalar $#foo) { $_ = 3 }
is $#foo, 3, 'assigning to arylen aliased in foreach(scalar $#arylen)';
+{
+ my @a = qw(a b c);
+ @a = @a;
+ is "@a", 'a b c', 'assigning to itself';
+}
+
"We're included by lib/Tie/Array/std.t so we need to return something true";
torture_hash('0 .. 9', 0 .. 9);
torture_hash("'Perl'", 'Rules');
+{
+ my %h = qw(a x b y c z);
+ no warnings qw(misc uninitialized);
+ %h = $h{a};
+ is(join(':', %h), 'x:', 'hash self-assign');
+}
+
done_testing();
set_up_inc('../lib');
}
use warnings;
-plan(tests => 190);
+plan(tests => 189);
# these shouldn't hang
{
is $@, "", 'abrupt scope exit turns off readonliness';
}
-{
- local $TODO = "sort should make sure elements are not freed in the sort block";
- eval { @nomodify_x=(1..8);
- our @copy = sort { undef @nomodify_x; 1 } (@nomodify_x, 3); };
- is($@, "");
-}
+# I commented out this TODO test because messing with FREEd scalars on the
+# stack can have all sorts of strange side-effects, not made safe by eval
+# - DAPM.
+#
+#{
+# local $TODO = "sort should make sure elements are not freed in the sort block";
+# eval { @nomodify_x=(1..8);
+# our @copy = sort { undef @nomodify_x; 1 } (@nomodify_x, 3); };
+# is($@, "");
+#}
# Sorting shouldn't increase the refcount of a sub
code => 'index $x, "b"',
},
+
+ # list assign, OP_AASSIGN
+
+
+ # (....) = ()
+
+ 'expr::aassign::ma_empty' => {
+ desc => 'my array assigned empty',
+ setup => '',
+ code => 'my @a = ()',
+ },
+ 'expr::aassign::lax_empty' => {
+ desc => 'non-empty lexical array assigned empty',
+ setup => 'my @a = 1..3;',
+ code => '@a = ()',
+ },
+ 'expr::aassign::llax_empty' => {
+ desc => 'non-empty lexical var and array assigned empty',
+ setup => 'my ($x, @a) = 1..4;',
+ code => '($x, @a) = ()',
+ },
+ 'expr::aassign::3m_empty' => {
+ desc => 'three my vars assigned empty',
+ setup => '',
+ code => 'my ($x,$y,$z) = ()',
+ },
+ 'expr::aassign::3l_empty' => {
+ desc => 'three lexical vars assigned empty',
+ setup => 'my ($x,$y,$z)',
+ code => '($x,$y,$z) = ()',
+ },
+ 'expr::aassign::pa_empty' => {
+ desc => 'package array assigned empty',
+ setup => '',
+ code => '@a = ()',
+ },
+ 'expr::aassign::pax_empty' => {
+ desc => 'non-empty package array assigned empty',
+ setup => '@a = (1,2,3)',
+ code => '@a = ()',
+ },
+ 'expr::aassign::3p_empty' => {
+ desc => 'three package vars assigned empty',
+ setup => '($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = ()',
+ },
+
+ # (....) = (1,2,3)
+
+ 'expr::aassign::ma_3c' => {
+ desc => 'my array assigned 3 consts',
+ setup => '',
+ code => 'my @a = (1,2,3)',
+ },
+ 'expr::aassign::lax_3c' => {
+ desc => 'non-empty lexical array assigned 3 consts',
+ setup => 'my @a = 1..3;',
+ code => '@a = (1,2,3)',
+ },
+ 'expr::aassign::llax_3c' => {
+ desc => 'non-empty lexical var and array assigned 3 consts',
+ setup => 'my ($x, @a) = 1..4;',
+ code => '($x, @a) = (1,2,3)',
+ },
+ 'expr::aassign::3m_3c' => {
+ desc => 'three my vars assigned 3 consts',
+ setup => '',
+ code => 'my ($x,$y,$z) = (1,2,3)',
+ },
+ 'expr::aassign::3l_3c' => {
+ desc => 'three lexical vars assigned 3 consts',
+ setup => 'my ($x,$y,$z)',
+ code => '($x,$y,$z) = (1,2,3)',
+ },
+ 'expr::aassign::pa_3c' => {
+ desc => 'package array assigned 3 consts',
+ setup => '',
+ code => '@a = (1,2,3)',
+ },
+ 'expr::aassign::pax_3c' => {
+ desc => 'non-empty package array assigned 3 consts',
+ setup => '@a = (1,2,3)',
+ code => '@a = (1,2,3)',
+ },
+ 'expr::aassign::3p_3c' => {
+ desc => 'three package vars assigned 3 consts',
+ setup => '($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = (1,2,3)',
+ },
+
+ # (....) = @lexical
+
+ 'expr::aassign::ma_la' => {
+ desc => 'my array assigned lexical array',
+ setup => 'my @init = 1..3;',
+ code => 'my @a = @init',
+ },
+ 'expr::aassign::lax_la' => {
+ desc => 'non-empty lexical array assigned lexical array',
+ setup => 'my @init = 1..3; my @a = 1..3;',
+ code => '@a = @init',
+ },
+ 'expr::aassign::llax_la' => {
+ desc => 'non-empty lexical var and array assigned lexical array',
+ setup => 'my @init = 1..3; my ($x, @a) = 1..4;',
+ code => '($x, @a) = @init',
+ },
+ 'expr::aassign::3m_la' => {
+ desc => 'three my vars assigned lexical array',
+ setup => 'my @init = 1..3;',
+ code => 'my ($x,$y,$z) = @init',
+ },
+ 'expr::aassign::3l_la' => {
+ desc => 'three lexical vars assigned lexical array',
+ setup => 'my @init = 1..3; my ($x,$y,$z)',
+ code => '($x,$y,$z) = @init',
+ },
+ 'expr::aassign::pa_la' => {
+ desc => 'package array assigned lexical array',
+ setup => 'my @init = 1..3;',
+ code => '@a = @init',
+ },
+ 'expr::aassign::pax_la' => {
+ desc => 'non-empty package array assigned lexical array',
+ setup => 'my @init = 1..3; @a = @init',
+ code => '@a = @init',
+ },
+ 'expr::aassign::3p_la' => {
+ desc => 'three package vars assigned lexical array',
+ setup => 'my @init = 1..3; ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = @init',
+ },
+
+ # (....) = @package
+
+ 'expr::aassign::ma_pa' => {
+ desc => 'my array assigned package array',
+ setup => '@init = 1..3;',
+ code => 'my @a = @init',
+ },
+ 'expr::aassign::lax_pa' => {
+ desc => 'non-empty lexical array assigned package array',
+ setup => '@init = 1..3; my @a = 1..3;',
+ code => '@a = @init',
+ },
+ 'expr::aassign::llax_pa' => {
+ desc => 'non-empty lexical var and array assigned package array',
+ setup => '@init = 1..3; my ($x, @a) = 1..4;',
+ code => '($x, @a) = @init',
+ },
+ 'expr::aassign::3m_pa' => {
+ desc => 'three my vars assigned package array',
+ setup => '@init = 1..3;',
+ code => 'my ($x,$y,$z) = @init',
+ },
+ 'expr::aassign::3l_pa' => {
+ desc => 'three lexical vars assigned package array',
+ setup => '@init = 1..3; my ($x,$y,$z)',
+ code => '($x,$y,$z) = @init',
+ },
+ 'expr::aassign::pa_pa' => {
+ desc => 'package array assigned package array',
+ setup => '@init = 1..3;',
+ code => '@a = @init',
+ },
+ 'expr::aassign::pax_pa' => {
+ desc => 'non-empty package array assigned package array',
+ setup => '@init = 1..3; @a = @init',
+ code => '@a = @init',
+ },
+ 'expr::aassign::3p_pa' => {
+ desc => 'three package vars assigned package array',
+ setup => '@init = 1..3; ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = @init',
+ },
+
+ # (....) = @_;
+
+ 'expr::aassign::ma_defary' => {
+ desc => 'my array assigned @_',
+ setup => '@_ = 1..3;',
+ code => 'my @a = @_',
+ },
+ 'expr::aassign::lax_defary' => {
+ desc => 'non-empty lexical array assigned @_',
+ setup => '@_ = 1..3; my @a = 1..3;',
+ code => '@a = @_',
+ },
+ 'expr::aassign::llax_defary' => {
+ desc => 'non-empty lexical var and array assigned @_',
+ setup => '@_ = 1..3; my ($x, @a) = 1..4;',
+ code => '($x, @a) = @_',
+ },
+ 'expr::aassign::3m_defary' => {
+ desc => 'three my vars assigned @_',
+ setup => '@_ = 1..3;',
+ code => 'my ($x,$y,$z) = @_',
+ },
+ 'expr::aassign::3l_defary' => {
+ desc => 'three lexical vars assigned @_',
+ setup => '@_ = 1..3; my ($x,$y,$z)',
+ code => '($x,$y,$z) = @_',
+ },
+ 'expr::aassign::pa_defary' => {
+ desc => 'package array assigned @_',
+ setup => '@_ = 1..3;',
+ code => '@a = @_',
+ },
+ 'expr::aassign::pax_defary' => {
+ desc => 'non-empty package array assigned @_',
+ setup => '@_ = 1..3; @a = @_',
+ code => '@a = @_',
+ },
+ 'expr::aassign::3p_defary' => {
+ desc => 'three package vars assigned @_',
+ setup => '@_ = 1..3; ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = @_',
+ },
+
+
+ # (....) = ($lex1,$lex2,$lex3);
+
+ 'expr::aassign::ma_3l' => {
+ desc => 'my array assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3;',
+ code => 'my @a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::lax_3l' => {
+ desc => 'non-empty lexical array assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3; my @a = 1..3;',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::llax_3l' => {
+ desc => 'non-empty lexical var and array assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;',
+ code => '($x, @a) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3m_3l' => {
+ desc => 'three my vars assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3;',
+ code => 'my ($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3l_3l' => {
+ desc => 'three lexical vars assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3; my ($x,$y,$z)',
+ code => '($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::pa_3l' => {
+ desc => 'package array assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3;',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::pax_3l' => {
+ desc => 'non-empty package array assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3; @a = @_',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3p_3l' => {
+ desc => 'three package vars assigned lexicals',
+ setup => 'my ($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+
+
+ # (....) = ($pkg1,$pkg2,$pkg3);
+
+ 'expr::aassign::ma_3p' => {
+ desc => 'my array assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3;',
+ code => 'my @a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::lax_3p' => {
+ desc => 'non-empty lexical array assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3; my @a = 1..3;',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::llax_3p' => {
+ desc => 'non-empty lexical var and array assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3; my ($x, @a) = 1..4;',
+ code => '($x, @a) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3m_3p' => {
+ desc => 'three my vars assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3;',
+ code => 'my ($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3l_3p' => {
+ desc => 'three lexical vars assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3; my ($x,$y,$z)',
+ code => '($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::pa_3p' => {
+ desc => 'package array assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3;',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::pax_3p' => {
+ desc => 'non-empty package array assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3; @a = @_',
+ code => '@a = ($v1,$v2,$v3)',
+ },
+ 'expr::aassign::3p_3p' => {
+ desc => 'three package vars assigned 3 package vars',
+ setup => '($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = ($v1,$v2,$v3)',
+ },
+
+
+ # (....) = (1,2,$shared);
+
+ 'expr::aassign::llax_2c1s' => {
+ desc => 'non-empty lexical var and array assigned 2 consts and 1 shared var',
+ setup => 'my ($x, @a) = 1..4;',
+ code => '($x, @a) = (1,2,$x)',
+ },
+ 'expr::aassign::3l_2c1s' => {
+ desc => 'three lexical vars assigned 2 consts and 1 shared var',
+ setup => 'my ($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = (1,2,$x)',
+ },
+ 'expr::aassign::3p_2c1s' => {
+ desc => 'three package vars assigned 2 consts and 1 shared var',
+ setup => '($x,$y,$z) = 1..3;',
+ code => '($x,$y,$z) = (1,2,$x)',
+ },
+
+
+ # ($a,$b) = ($b,$a);
+
+ 'expr::aassign::2l_swap' => {
+ desc => 'swap two lexical vars',
+ setup => 'my ($a,$b) = (1,2)',
+ code => '($a,$b) = ($b,$a)',
+ },
+ 'expr::aassign::2p_swap' => {
+ desc => 'swap two package vars',
+ setup => '($a,$b) = (1,2)',
+ code => '($a,$b) = ($b,$a)',
+ },
+ 'expr::aassign::2laelem_swap' => {
+ desc => 'swap two lexical vars',
+ setup => 'my @a = (1,2)',
+ code => '($a[0],$a[1]) = ($a[1],$a[0])',
+ },
+
+ # misc list assign
+
+ 'expr::aassign::5l_4l1s' => {
+ desc => 'long list of lexical vars, 1 shared',
+ setup => 'my ($a,$b,$c,$d,$e) = 1..5',
+ code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)',
+ },
+
+ 'expr::aassign::5p_4p1s' => {
+ desc => 'long list of package vars, 1 shared',
+ setup => '($a,$b,$c,$d,$e) = 1..5',
+ code => '($a,$b,$c,$d,$e) = ($a,$a,$c,$d,$e)',
+ },
+ 'expr::aassign::5l_defary' => {
+ desc => 'long list of lexical vars to assign @_ to',
+ setup => '@_ = 1..5',
+ code => 'my ($a,$b,$c,$d,$e) = @_',
+ },
+ 'expr::aassign::5l1la_defary' => {
+ desc => 'long list of lexical vars plus long slurp to assign @_ to',
+ setup => '@_ = 1..20',
+ code => 'my ($a,$b,$c,$d,$e,@rest) = @_',
+ },
+
+
];
@INC = '../lib';
}
-plan 24;
+plan 51;
use v5.10; # state
-use B qw 'svref_2object OPpASSIGN_COMMON';
-
+use B qw(svref_2object
+ OPpASSIGN_COMMON_SCALAR
+ OPpASSIGN_COMMON_RC1
+ OPpASSIGN_COMMON_AGG
+ );
+
+
+# Test that OP_AASSIGN gets the appropriate
+# OPpASSIGN_COMMON* flags set.
+#
+# Too few flags set is likely to cause code to misbehave;
+# too many flags set unnecessarily slows things down.
+# See also the tests in t/op/aassign.t
+
+for my $test (
+ # Each anon array contains:
+ # [
+ # expected flags:
+ # a 3 char string, each char showing whether we expect a
+ # particular flag to be set:
+ # '-' indicates any char not set, while
+ # 'S': char 0: OPpASSIGN_COMMON_SCALAR,
+ # 'R': char 1: OPpASSIGN_COMMON_RC1,
+ # 'A' char 2: OPpASSIGN_COMMON_AGG,
+ # code to eval,
+ # description,
+ # ]
+
+ [ "---", '() = (1, $x, my $y, @z, f($p))', 'no LHS' ],
+ [ "---", '(undef, $x, my $y, @z, ($a ? $b : $c)) = ()', 'no RHS' ],
+ [ "---", '(undef, $x, my $y, @z, ($a ? $b : $c)) = (1,2)', 'safe RHS' ],
+ [ "---", 'my @a = (1,2)', 'safe RHS: my array' ],
+ [ "---", 'my %h = (1,2)', 'safe RHS: my hash' ],
+ [ "---", 'my ($a,$b,$c,$d) = 1..6; ($a,$b) = ($c,$d);', 'non-common lex' ],
+ [ "---", '($x,$y) = (1,2)', 'pkg var LHS only' ],
+ [ "---", 'my $p; my ($x,$y) = ($p, $p)', 'my; dup lex var on RHS' ],
+ [ "---", 'my $p; my ($x,$y); ($x,$y) = ($p, $p)', 'dup lex var on RHS' ],
+ [ "-R-", 'my ($self) = @_', 'LHS lex scalar only' ],
+ [ "-RA", 'my ($self, @rest) = @_', 'LHS lex mixed' ],
+ [ "-R-", 'my ($x,$y) = ($p, $q)', 'pkg var RHS only' ],
+ [ "S--", '($x,$y) = ($p, $q)', 'pkg scalar both sides' ],
+ [ "--A", 'my (@a, @b); @a = @b', 'lex ary both sides' ],
+ [ "-R-", 'my ($x,$y,$z,@a); ($x,$y,$z) = @a ', 'lex vars to lex ary' ],
+ [ "--A", '@a = @b', 'pkg ary both sides' ],
+ [ "--A", 'my (%a,%b); %a = %b', 'lex hash both sides' ],
+ [ "--A", '%a = %b', 'pkg hash both sides' ],
+ [ "--A", 'my $x; @a = ($a[0], $a[$x])', 'common ary' ],
+ [ "--A", 'my ($x,@a); @a = ($a[0], $a[$x])', 'common lex ary' ],
+ [ "S-A", 'my $x; ($a[$x], $a[0]) = ($a[0], $a[$x])', 'common ary elems' ],
+ [ "S-A", 'my ($x,@a); ($a[$x], $a[0]) = ($a[0], $a[$x])',
+ 'common lex ary elems' ],
+ [ "--A", 'my $x; my @a = @$x', 'lex ary may have stuff' ],
+ [ "-RA", 'my $x; my ($b, @a) = @$x', 'lex ary may have stuff' ],
+ [ "--A", 'my $x; my %a = @$x', 'lex hash may have stuff' ],
+ [ "-RA", 'my $x; my ($b, %a) = @$x', 'lex hash may have stuff' ],
+ [ "--A", 'my (@a,@b); @a = ($b[0])', 'lex ary and elem' ],
+ [ "S-A", 'my @a; ($a[1],$a[0]) = @a', 'lex ary and elem' ],
+ [ "--A", 'my @x; @y = $x[0]', 'pkg ary from lex elem' ],
+) {
+ my ($exp, $code, $desc) = @$test;
+ my $sub = eval "sub { $code }"
+ or die
+ "aassign eval('$code') failed: this test needs to be rewritten:\n"
+ . $@;
-# aassign with no common vars
-for ('my ($self) = @_',
- 'my @x; @y = $x[0]', # aelemfast_lex
- )
-{
- my $sub = eval "sub { $_ }";
- my $last_expr =
- svref_2object($sub)->ROOT->first->last;
+ my $last_expr = svref_2object($sub)->ROOT->first->last;
if ($last_expr->name ne 'aassign') {
die "Expected aassign but found ", $last_expr->name,
"; this test needs to be rewritten"
}
- is $last_expr->private & OPpASSIGN_COMMON, 0,
- "no ASSIGN_COMMON for $_";
+ my $got =
+ (($last_expr->private & OPpASSIGN_COMMON_SCALAR) ? 'S' : '-')
+ . (($last_expr->private & OPpASSIGN_COMMON_RC1) ? 'R' : '-')
+ . (($last_expr->private & OPpASSIGN_COMMON_AGG) ? 'A' : '-');
+ is $got, $exp, "OPpASSIGN_COMMON: $desc: '$code'";
}
https://perl5.git.perl.org / perl5.git / commitdiff