In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d219a6caabadff92085b30a1b95bd654b759ea4a?hp=a0d9739dbf6962a32b3417203c52f88526e790d8>
- Log ----------------------------------------------------------------- commit d219a6caabadff92085b30a1b95bd654b759ea4a Author: Father Chrysostomos <[email protected]> Date: Mon Sep 22 21:56:15 2014 -0700 Increase $B::VERSION to 1.52 M ext/B/B.pm commit 14d91147b4bfd5289f2548af3eb0d745d241b9f8 Author: Father Chrysostomos <[email protected]> Date: Mon Sep 22 21:48:48 2014 -0700 Stop flip from returning the same scalar each time sub f { for my $n (1..5) { my $x = \scalar($n == 2 .. $n == 4); $_ = $x if $n == 1; print "$n: $$_\n"; } print("-----\n"), f() if @_ } f(1); Output: 1: 2: 1 3: 2 4: 3E0 5: ----- 1: 2: 3: 4: 5: When f() is called, it evaluates a flipflop five times. It takes a reference to the return value the first time, and prints that same scalar for each iteration. Notice how the very same scalar is returned each time in the outer sub call, but the recursive call hides that implementation detail. .. should not be returning the same scalar each time, or at least that implementation detail should not leak through. (Most operators do reuse the same scalar, but the scalar is flagged such that \ will copy it, hiding that fact.) This was happening because of the eccentric way that the flipflop targets are allocated in the pad. They are allocated as PADMY (i.e., like âmyâ variables), but without a name. pad_push (which creates a new pad for recursion) assumes that anything without a name is PADTMP instead (copy on reference). So the recursive call behaves correctly. I am not sure why the targets were allocated with PADMY to begin with. (This goes back to perl 5.000.) But now the PADMY prevents the tar- gets from being shared with other ops under USE_PAD_RESET builds. The better way to allocate these targets is to use PADMY as before, but actually give those slots names. The target that gets returned needs to be marked PADTMP, so we also need to copy that flag in pad_push. M op.c M pad.c M t/op/flip.t commit 39ff6c37b02dc106ce36a529c4fdd80ac93c7ada Author: Father Chrysostomos <[email protected]> Date: Mon Sep 22 21:45:26 2014 -0700 gv.h: Make gp_line and gp_flags into a bitfield This reduces the allocated size on Windows, where an extra header is added to what gets allocated. See <https://rt.perl.org/Ticket/Display.html?id=15667#txn-1309657>. M ext/B/B.xs M gv.h commit 9d27f1291975183b2c21d24d15bedf5f24622faa Author: Father Chrysostomos <[email protected]> Date: Mon Sep 22 08:31:09 2014 -0700 Peek.t: Drop 5.8 support There is no reason these tests need to run on such an old version any more, and this is getting in the way of something I am trying to do. M ext/Devel-Peek/t/Peek.t ----------------------------------------------------------------------- Summary of changes: ext/B/B.pm | 2 +- ext/B/B.xs | 9 ++--- ext/Devel-Peek/t/Peek.t | 105 +++++++++--------------------------------------- gv.h | 4 +- op.c | 6 ++- pad.c | 4 ++ t/op/flip.t | 5 ++- 7 files changed, 39 insertions(+), 96 deletions(-) diff --git a/ext/B/B.pm b/ext/B/B.pm index d50a9d6..f0dd77a 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.51'; + $B::VERSION = '1.52'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 17614cb..15cadaf 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1757,7 +1757,6 @@ GvGP(gv) #define GP_av_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_av) #define GP_form_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_form) #define GP_egv_ix (SVp << 16) | STRUCT_OFFSET(struct gp, gp_egv) -#define GP_line_ix (line_tp << 16) | STRUCT_OFFSET(struct gp, gp_line) void SV(gv) @@ -1772,7 +1771,6 @@ SV(gv) AV = GP_av_ix FORM = GP_form_ix EGV = GP_egv_ix - LINE = GP_line_ix PREINIT: GP *gp; char *ptr; @@ -1791,15 +1789,16 @@ SV(gv) case U32p: ret = sv_2mortal(newSVuv(*((U32*)ptr))); break; - case line_tp: - ret = sv_2mortal(newSVuv(*((line_t *)ptr))); - break; default: croak("Illegal alias 0x%08x for B::*SV", (unsigned)ix); } ST(0) = ret; XSRETURN(1); +U32 +GvLINE(gv) + B::GV gv + void FILEGV(gv) B::GV gv diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 99d29b4..9f386d9 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -83,10 +83,7 @@ sub do_test { } split /^/, $pattern; $pattern =~ s/\$PADMY/ - ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY'; - /mge; - $pattern =~ s/\$PADTMP/ - ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP'; + 'PADMY'; /mge; $pattern =~ s/\$RV/ ($] < 5.011) ? 'RV' : 'IV'; @@ -262,8 +259,6 @@ do_test('reference to array', SV = PVAV\\($ADDR\\) at $ADDR REFCNT = 1 FLAGS = \\(\\) - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 ARRAY = $ADDR FILL = 1 MAX = 1 @@ -285,8 +280,6 @@ do_test('reference to hash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = [12] FLAGS = \\(SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -294,7 +287,7 @@ do_test('reference to hash', MAX = 7 Elt "123" HASH = $ADDR' . $c_pattern, '', - $] > 5.009 && $] < 5.015 + $] < 5.015 && 'The hash iterator used in dump.c sets the OOK flag'); do_test('reference to anon sub with empty prototype', @@ -307,21 +300,16 @@ do_test('reference to anon sub with empty prototype', REFCNT = 2 FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC\\) # $] < 5.015 || !thr FLAGS = \\($PADMY,POK,pPOK,ANON,WEAKOUTSIDE,CVGV_RC,DYNFILE\\) # $] >= 5.015 && thr - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 PROTOTYPE = "" COMP_STASH = $ADDR\\t"main" START = $ADDR ===> \\d+ ROOT = $ADDR - XSUB = 0x0 # $] < 5.009 - XSUBANY = 0 # $] < 5.009 GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*" FILE = ".*\\b(?i:peek\\.t)" DEPTH = 0(?: MUTEXP = $ADDR OWNER = $ADDR)? - FLAGS = 0x404 # $] < 5.009 - FLAGS = 0x490 # $] >= 5.009 && ($] < 5.015 || !thr) + FLAGS = 0x490 # $] < 5.015 || !thr FLAGS = 0x1490 # $] >= 5.015 && thr OUTSIDE_SEQ = \\d+ PADLIST = $ADDR @@ -338,13 +326,9 @@ do_test('reference to named subroutine without prototype', REFCNT = (3|4) FLAGS = \\((?:HASEVAL(?:,NAMED)?)?\\) # $] < 5.015 || !thr FLAGS = \\(DYNFILE(?:,HASEVAL(?:,NAMED)?)?\\) # $] >= 5.015 && thr - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 COMP_STASH = $ADDR\\t"main" START = $ADDR ===> \\d+ ROOT = $ADDR - XSUB = 0x0 # $] < 5.009 - XSUBANY = 0 # $] < 5.009 NAME = "do_test" # $] >=5.021004 GVGV::GV = $ADDR\\t"main" :: "do_test" # $] < 5.021004 FILE = ".*\\b(?i:peek\\.t)" @@ -361,8 +345,7 @@ do_test('reference to named subroutine without prototype', \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern" \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$do_eval" \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$sub" - \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" # $] < 5.009 - \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 # $] >= 5.009 + \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump" \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2" OUTSIDE = $ADDR \\(MAIN\\)'); @@ -455,8 +438,8 @@ do_test('reference to regexp', MG_VIRTUAL = $ADDR MG_TYPE = PERL_MAGIC_qr\(r\) MG_OBJ = $ADDR - PAT = "\(\?^:tic\)" # $] >= 5.009 - REFCNT = 2 # $] >= 5.009 + PAT = "\(\?^:tic\)" + REFCNT = 2 STASH = $ADDR\\t"Regexp"'); } @@ -469,32 +452,20 @@ do_test('reference to blessed hash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = [12] FLAGS = \\(OBJECT,SHAREKEYS\\) - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 STASH = $ADDR\\t"Tac" ARRAY = 0x0 KEYS = 0 FILL = 0 MAX = 7', '', - $] > 5.009 - ? $] >= 5.015 + $] >= 5.015 ? 0 - : 'The hash iterator used in dump.c sets the OOK flag' - : "Something causes the HV's array to become allocated"); + : 'The hash iterator used in dump.c sets the OOK flag'); do_test('typeglob', *a, 'SV = PVGV\\($ADDR\\) at $ADDR REFCNT = 5 - FLAGS = \\(MULTI(?:,IN_PAD)?\\) # $] >= 5.009 - FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\) # $] < 5.009 - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 - PV = 0 # $] < 5.009 - MAGIC = $ADDR # $] < 5.009 - MG_VIRTUAL = &PL_vtbl_glob # $] < 5.009 - MG_TYPE = PERL_MAGIC_glob\(\*\) # $] < 5.009 - MG_OBJ = $ADDR # $] < 5.009 + FLAGS = \\(MULTI(?:,IN_PAD)?\\) NAME = "a" NAMELEN = 1 GvSTASH = $ADDR\\t"main" @@ -508,7 +479,6 @@ do_test('typeglob', HV = 0x0 CV = 0x0 CVGEN = 0x0 - GPFLAGS = 0x0 # $] < 5.009 GPFLAGS = 0x0 \(\) # $] >= 5.021004 LINE = \\d+ FILE = ".*\\b(?i:peek\\.t)" @@ -520,8 +490,8 @@ do_test('string with Unicode', chr(256).chr(0).chr(512), 'SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003 - FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003 + FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003 + FLAGS = \\((?:PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003 PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] CUR = 5 LEN = \\d+ @@ -532,8 +502,8 @@ do_test('string with Unicode', chr(256).chr(0).chr(512), 'SV = PV\\($ADDR\\) at $ADDR REFCNT = 1 - FLAGS = \\((?:$PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003 - FLAGS = \\((?:$PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003 + FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\) # $] < 5.019003 + FLAGS = \\((?:PADTMP,)?POK,(?:IsCOW,)?pPOK,UTF8\\) # $] >=5.019003 PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\] CUR = 5 LEN = \\d+ @@ -551,8 +521,6 @@ do_test('reference to hash containing Unicode', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = [12] FLAGS = \\(SHAREKEYS,HASKFLAGS\\) - UV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -567,11 +535,9 @@ do_test('reference to hash containing Unicode', LEN = \\d+ COW_REFCNT = 1 # $] < 5.019007 ', '', - $] > 5.009 - ? $] >= 5.015 + $] >= 5.015 ? 0 - : 'The hash iterator used in dump.c sets the OOK flag' - : 'sv_length has been called on the element, and cached the result in MAGIC'); + : 'The hash iterator used in dump.c sets the OOK flag'); } else { do_test('reference to hash containing Unicode', {chr(256)=>chr(512)}, @@ -582,8 +548,6 @@ do_test('reference to hash containing Unicode', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = [12] FLAGS = \\(SHAREKEYS,HASKFLAGS\\) - UV = 1 # $] < 5.009 - NV = 0 # $] < 5.009 ARRAY = $ADDR \\(0:7, 1:1\\) hash quality = 100.0% KEYS = 1 @@ -598,11 +562,9 @@ do_test('reference to hash containing Unicode', LEN = \\d+ COW_REFCNT = 1 # $] < 5.019007 ', '', - $] > 5.009 - ? $] >= 5.015 + $] >= 5.015 ? 0 - : 'The hash iterator used in dump.c sets the OOK flag' - : 'sv_length has been called on the element, and cached the result in MAGIC'); + : 'The hash iterator used in dump.c sets the OOK flag'); } my $x=""; @@ -704,12 +666,9 @@ do_test('constant subroutine', REFCNT = (2) FLAGS = \\(POK,pPOK,CONST,ISXSUB\\) # $] < 5.015 FLAGS = \\(POK,pPOK,CONST,DYNFILE,ISXSUB\\) # $] >= 5.015 - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 PROTOTYPE = "" COMP_STASH = 0x0 # $] < 5.021004 COMP_STASH = $ADDR "main" # $] >=5.021004 - ROOT = 0x0 # $] < 5.009 XSUB = $ADDR XSUBANY = $ADDR \\(CONST SV\\) SV = PV\\($ADDR\\) at $ADDR @@ -725,8 +684,7 @@ do_test('constant subroutine', DEPTH = 0(?: MUTEXP = $ADDR OWNER = $ADDR)? - FLAGS = 0x200 # $] < 5.009 - FLAGS = 0xc00 # $] >= 5.009 && $] < 5.013 + FLAGS = 0xc00 # $] < 5.013 FLAGS = 0xc # $] >= 5.013 && $] < 5.015 FLAGS = 0x100c # $] >= 5.015 OUTSIDE_SEQ = 0 @@ -764,7 +722,6 @@ do_test('IO', TOP_GV = 0x0 FMT_GV = 0x0 BOTTOM_GV = 0x0 - SUBPROCESS = 0 # $] < 5.009 TYPE = \'>\' FLAGS = 0x4'); @@ -778,14 +735,10 @@ do_test('FORMAT', REFCNT = 2 FLAGS = \\(\\) # $] < 5.015 || !thr FLAGS = \\(DYNFILE\\) # $] >= 5.015 && thr - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 (?: PV = 0 )? COMP_STASH = 0x0 START = $ADDR ===> \\d+ ROOT = $ADDR - XSUB = 0x0 # $] < 5.009 - XSUBANY = 0 # $] < 5.009 GVGV::GV = $ADDR\\t"main" :: "PIE" FILE = ".*\\b(?i:peek\\.t)"(?: DEPTH = 0)?(?: @@ -808,18 +761,14 @@ do_test('blessing to a class with embedded NUL characters', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = [12] FLAGS = \\(OBJECT,SHAREKEYS\\) - IV = 0 # $] < 5.009 - NV = 0 # $] < 5.009 STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0" ARRAY = $ADDR KEYS = 0 FILL = 0 MAX = 7', '', - $] > 5.009 - ? $] >= 5.015 + $] >= 5.015 ? 0 - : 'The hash iterator used in dump.c sets the OOK flag' - : "Something causes the HV's array to become allocated"); + : 'The hash iterator used in dump.c sets the OOK flag'); do_test('ENAME on a stash', \%RWOM::, @@ -830,8 +779,6 @@ do_test('ENAME on a stash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 2 FLAGS = \\(OOK,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR KEYS = 0 @@ -855,8 +802,6 @@ do_test('ENAMEs on a stash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 3 FLAGS = \\(OOK,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR KEYS = 0 @@ -883,8 +828,6 @@ do_test('ENAMEs on a stash with no NAME', FLAGS = \\(OOK,SHAREKEYS\\) # $] < 5.017 FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017 && $]<5.021005 FLAGS = \\(OOK,SHAREKEYS,OVERLOAD\\) # $] >=5.021005 - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR KEYS = 0 @@ -908,8 +851,6 @@ do_test('small hash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 2 FLAGS = \\(PADMY,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 ARRAY = $ADDR \\(0:[67],.*\\) hash quality = [0-9.]+% KEYS = 2 @@ -936,8 +877,6 @@ do_test('small hash after keys', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 2 FLAGS = \\(PADMY,OOK,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR \\(0:[67],.*\\) hash quality = [0-9.]+% @@ -968,8 +907,6 @@ do_test('small hash after keys and scalar', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 2 FLAGS = \\(PADMY,OOK,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR \\(0:[67],.*\\) hash quality = [0-9.]+% @@ -1001,8 +938,6 @@ do_test('large hash', SV = PVHV\\($ADDR\\) at $ADDR REFCNT = 2 FLAGS = \\(PADMY,OOK,SHAREKEYS\\) - IV = 1 # $] < 5.009 - NV = $FLOAT # $] < 5.009 AUX_FLAGS = 0 # $] > 5.019008 ARRAY = $ADDR \\(0:\d+,.*\\) hash quality = \d+\\.\d+% diff --git a/gv.h b/gv.h index 2b29b6d..cf096c3 100644 --- a/gv.h +++ b/gv.h @@ -18,8 +18,8 @@ struct gp { AV * gp_av; /* array value */ CV * gp_form; /* format value */ GV * gp_egv; /* effective gv, if *glob */ - line_t gp_line; /* line first declared at (for -w) */ - U32 gp_flags; + U32 gp_line:31; /* line first declared at (for -w) */ + U32 gp_flags:1; HEK * gp_file_hek; /* file first declared in (for -w) */ }; diff --git a/op.c b/op.c index 3625bc3..42f73ed 100644 --- a/op.c +++ b/op.c @@ -6363,10 +6363,12 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) left->op_next = flip; right->op_next = flop; - range->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); + range->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0); sv_upgrade(PAD_SV(range->op_targ), SVt_PVNV); - flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY); + flip->op_targ = pad_add_name_pvn("$", 1, padadd_NO_DUP_CHECK, 0, 0);; sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV); + SvFLAGS(PAD_SV(flip->op_targ)) &=~ SVs_PADMY; + SvPADTMP_on(PAD_SV(flip->op_targ)); flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; diff --git a/pad.c b/pad.c index fafb946..1306a0a 100644 --- a/pad.c +++ b/pad.c @@ -2375,7 +2375,11 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) else if (sigil == '%') sv = MUTABLE_SV(newHV()); else + { sv = newSV(0); + /* For flip-flop targets: */ + if (SvPADTMP(oldpad[ix])) SvPADTMP_on(sv); + } av_store(newpad, ix, sv); SvPADMY_on(sv); } diff --git a/t/op/flip.t b/t/op/flip.t index 8526db7..bb1526d 100644 --- a/t/op/flip.t +++ b/t/op/flip.t @@ -4,7 +4,7 @@ BEGIN { require "test.pl"; } -plan(11); +plan(12); @a = (1,2,3,4,5,6,7,8,9,10,11,12); @b = (); @@ -62,3 +62,6 @@ $warn = ''; $. = 15; ok(scalar(15..0)); + +push @_, \scalar(0..0) for 1,2; +isnt $_[0], $_[1], '\scalar($a..$b) gives a different scalar each time'; -- Perl5 Master Repository
