my $repeat_todo = $_[4];
my $pattern = $_[2];
my $do_eval = $_[5];
- if (open(OUT,">peek$$")) {
+ if (open(OUT,'>', "peek$$")) {
open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
if ($do_eval) {
my $sub = eval "sub { Dump $_[1] }";
}
open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
close(OUT);
- if (open(IN, "peek$$")) {
+ if (open(IN, '<', "peek$$")) {
local $/;
$pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
$pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
# Could do this is in a s///mge but seems clearer like this:
$pattern = join '', map {
# If we identify the version condition, take *it* out whatever
- s/\s*# (\$].*)$//
+ s/\s*# (\$\].*)$//
? (eval $1 ? $_ : '')
: $_ # Didn't match, so this line is in
} split /^/, $pattern;
- $pattern =~ s/\$PADMY/
- ($] < 5.009) ? 'PADBUSY,PADMY' : 'PADMY';
- /mge;
- $pattern =~ s/\$PADTMP/
- ($] < 5.009) ? 'PADBUSY,PADTMP' : 'PADTMP';
+ $pattern =~ s/\$PADMY,/
+ $] < 5.012005 ? 'PADMY,' : '';
/mge;
$pattern =~ s/\$RV/
($] < 5.011) ? 'RV' : 'IV';
/mge;
$pattern =~ s/^\h+COW_REFCNT = .*\n//mg
if $Config{ccflags} =~
- /-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)/
+ /-DPERL_(?:OLD_COPY_ON_WRITE|NO_COW)\b/
|| $] < 5.019003;
print $pattern, "\n" if $DEBUG;
my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
"bar",
'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
+ FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\) # $] < 5.021005
+ FLAGS = \\(.*POK,(?:IsCOW,)?READONLY,PROTECT,pPOK\\) # $] >=5.021005
PV = $ADDR "bar"\\\0
CUR = 3
LEN = \\d+
456,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(.*IOK,READONLY,pIOK\\)
+ FLAGS = \\(.*IOK,READONLY,pIOK\\) # $] < 5.021005
+ FLAGS = \\(.*IOK,READONLY,PROTECT,pIOK\\) # $] >=5.021005
IV = 456');
do_test('assignment of immediate constant (integer)',
do_test('floating point value',
$d,
$] < 5.019003
- || $Config{ccflags} =~ /-DPERL_(?:NO_COW|OLD_COPY_ON_WRITE)/
+ || $Config{ccflags} =~ /-DPERL_(?:NO_COW|OLD_COPY_ON_WRITE)\b/
?
'SV = PVNV\\($ADDR\\) at $ADDR
REFCNT = 1
0xabcd,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(.*IOK,READONLY,pIOK\\)
+ FLAGS = \\(.*IOK,READONLY,pIOK\\) # $] < 5.021005
+ FLAGS = \\(.*IOK,READONLY,PROTECT,pIOK\\) # $] >=5.021005
IV = 43981');
do_test('undef',
undef,
'SV = NULL\\(0x0\\) at $ADDR
REFCNT = \d+
- FLAGS = \\(READONLY\\)');
+ FLAGS = \\(READONLY\\) # $] < 5.021005
+ FLAGS = \\(READONLY,PROTECT\\) # $] >=5.021005
+');
do_test('reference to scalar',
\$a,
SV = PVAV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(\\)
- IV = 0 # $] < 5.009
- NV = 0 # $] < 5.009
ARRAY = $ADDR
FILL = 1
MAX = 1
- ARYLEN = 0x0
FLAGS = \\(REAL\\)
Elt No. 0
SV = IV\\($ADDR\\) at $ADDR
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
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',
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
RV = $ADDR
SV = PVCV\\($ADDR\\) at $ADDR
REFCNT = (3|4)
- FLAGS = \\((?:HASEVAL)?\\) # $] < 5.015 || !thr
- FLAGS = \\(DYNFILE(?:,HASEVAL)?\\) # $] >= 5.015 && thr
- IV = 0 # $] < 5.009
- NV = 0 # $] < 5.009
+ FLAGS = \\((?:HASEVAL(?:,NAMED)?)?\\) # $] < 5.015 || !thr
+ FLAGS = \\(DYNFILE(?:,HASEVAL(?:,NAMED)?)?\\) # $] >= 5.015 && thr
COMP_STASH = $ADDR\\t"main"
START = $ADDR ===> \\d+
ROOT = $ADDR
- XSUB = 0x0 # $] < 5.009
- XSUBANY = 0 # $] < 5.009
- GVGV::GV = $ADDR\\t"main" :: "do_test"
+ NAME = "do_test" # $] >=5.021004
+ GVGV::GV = $ADDR\\t"main" :: "do_test" # $] < 5.021004
FILE = ".*\\b(?i:peek\\.t)"
DEPTH = 1(?:
MUTEXP = $ADDR
OWNER = $ADDR)?
- FLAGS = 0x(?:400)?0 # $] < 5.015 || !thr
- FLAGS = 0x[145]000 # $] >= 5.015 && thr
+ FLAGS = 0x(?:[c4]00)?0 # $] < 5.015 || !thr
+ FLAGS = 0x[cd145]000 # $] >= 5.015 && thr
OUTSIDE_SEQ = \\d+
PADLIST = $ADDR
PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
\\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\\)');
if ($] >= 5.011) {
+# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
do_test('reference to regexp',
qr(tic),
'SV = $RV\\($ADDR\\) at $ADDR
RV = $ADDR
SV = REGEXP\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,POK,FAKE,pPOK\\) # $] < 5.017006
- FLAGS = \\(OBJECT,FAKE\\) # $] >= 5.017006
+ FLAGS = \\(OBJECT,POK,FAKE,pPOK\\)
PV = $ADDR "\\(\\?\\^:tic\\)"
CUR = 8
LEN = 0 # $] < 5.017006
'
COMPFLAGS = 0x0 \(\)
EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
- INTFLAGS = 0x0
+(?: ENGINE = $ADDR \(STANDARD\)
+)? INTFLAGS = 0x0(?: \(\))?
NPARENS = 0
LASTPAREN = 0
LASTCLOSEPAREN = 0
SUBOFFSET = 0
SUBCOFFSET = 0
SUBBEG = 0x0
- ENGINE = $ADDR
- MOTHER_RE = $ADDR'
+(?: ENGINE = $ADDR
+)? MOTHER_RE = $ADDR'
. ($] < 5.019003 ? '' : '
SV = REGEXP\($ADDR\) at $ADDR
REFCNT = 2
- FLAGS = \(\)
+ FLAGS = \(POK,pPOK\)
PV = $ADDR "\(\?\^:tic\)"
CUR = 8
COMPFLAGS = 0x0 \(\)
EXTFLAGS = 0x680000 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
- INTFLAGS = 0x0
+(?: ENGINE = $ADDR \(STANDARD\)
+)? INTFLAGS = 0x0(?: \(\))?
NPARENS = 0
LASTPAREN = 0
LASTCLOSEPAREN = 0
SUBOFFSET = 0
SUBCOFFSET = 0
SUBBEG = 0x0
- ENGINE = $ADDR
- MOTHER_RE = 0x0
+(?: ENGINE = $ADDR
+)? MOTHER_RE = 0x0
PAREN_NAMES = 0x0
SUBSTRS = $ADDR
PPRIVATE = $ADDR
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"');
}
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"
+ FLAGS = $ADDR # $] >=5.021004
GP = $ADDR
SV = $ADDR
REFCNT = 1
HV = 0x0
CV = 0x0
CVGEN = 0x0
- GPFLAGS = 0x0 # $] < 5.009
+ GPFLAGS = 0x0 \(\) # $] >= 5.021004
LINE = \\d+
FILE = ".*\\b(?i:peek\\.t)"
- FLAGS = $ADDR
+ FLAGS = $ADDR # $] < 5.021004
EGV = $ADDR\\t"a"');
if (ord('A') == 193) {
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+
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+
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
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)},
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
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="";
# ENV hashes is also not always null terminated.
#
if (${^TAINT}) {
+ # Save and restore PATH, since fresh_perl ends up using that in Windows.
+ my $path = $ENV{PATH};
do_test('tainted value in %ENV',
$ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
'SV = PVMG\\($ADDR\\) at $ADDR
MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
SV = PV(?:IV)?\\($ADDR\\) at $ADDR
REFCNT = \d+
- FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
+ FLAGS = \\((?:TEMP,)?POK,(?:FAKE,READONLY,)?pPOK\\)
(?: IV = 0
)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
CUR = \d+
MAGIC = $ADDR
MG_VIRTUAL = &PL_vtbl_taint
MG_TYPE = PERL_MAGIC_taint\\(t\\)');
+ $ENV{PATH} = $path;
}
do_test('blessed reference',
RV = $ADDR
SV = NULL\\(0x0\\) at $ADDR
REFCNT = \d+
- FLAGS = \\(READONLY\\)
+ FLAGS = \\(READONLY\\) # $] < 5.021005
+ FLAGS = \\(READONLY,PROTECT\\) # $] >=5.021005
PV = $ADDR ""
CUR = 0
LEN = 0
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
- ROOT = 0x0 # $] < 5.009
+ COMP_STASH = 0x0 # $] < 5.021004
+ COMP_STASH = $ADDR "main" # $] >=5.021004
XSUB = $ADDR
XSUBANY = $ADDR \\(CONST SV\\)
SV = PV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\)
+ FLAGS = \\(.*POK,READONLY,(?:IsCOW,)?pPOK\\) # $] < 5.021005
+ FLAGS = \\(.*POK,(?:IsCOW,)?READONLY,PROTECT,pPOK\\) # $] >=5.021005
PV = $ADDR "Perl rules"\\\0
CUR = 10
LEN = \\d+
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
- PADLIST = 0x0
+ PADLIST = 0x0 # $] < 5.021006
+ HSCXT = $ADDR # $] >= 5.021006
OUTSIDE = 0x0 \\(null\\)');
do_test('isUV should show on PVMG',
TOP_GV = 0x0
FMT_GV = 0x0
BOTTOM_GV = 0x0
- SUBPROCESS = 0 # $] < 5.009
TYPE = \'>\'
FLAGS = 0x4');
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)?(?:
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::,
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
- FILL = 0 \(cached = 0\)
+ FILL = 0
MAX = 7
RITER = -1
EITER = 0x0
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
- FILL = 0 \(cached = 0\)
+ FILL = 0
MAX = 7
RITER = -1
EITER = 0x0
SV = PVHV\\($ADDR\\) at $ADDR
REFCNT = 3
FLAGS = \\(OOK,SHAREKEYS\\) # $] < 5.017
- FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017
- IV = 1 # $] < 5.009
- NV = $FLOAT # $] < 5.009
+ FLAGS = \\(OOK,OVERLOAD,SHAREKEYS\\) # $] >=5.017 && $]<5.021005
+ FLAGS = \\(OOK,SHAREKEYS,OVERLOAD\\) # $] >=5.021005
+ AUX_FLAGS = 0 # $] > 5.019008
ARRAY = $ADDR
KEYS = 0
- FILL = 0 \(cached = 0\)
+ FILL = 0
MAX = 7
RITER = -1
EITER = 0x0
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
REFCNT = 2
- FLAGS = \\(PADMY,SHAREKEYS\\)
- IV = 1 # $] < 5.009
- NV = $FLOAT # $] < 5.009
+ FLAGS = \\($PADMY,SHAREKEYS\\)
ARRAY = $ADDR \\(0:[67],.*\\)
hash quality = [0-9.]+%
KEYS = 2
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
REFCNT = 2
- FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
- IV = 1 # $] < 5.009
- NV = $FLOAT # $] < 5.009
+ FLAGS = \\($PADMY,OOK,SHAREKEYS\\)
+ AUX_FLAGS = 0 # $] > 5.019008
ARRAY = $ADDR \\(0:[67],.*\\)
hash quality = [0-9.]+%
KEYS = 2
- FILL = [12] \\(cached = 0\\)
+ FILL = [12]
MAX = 7
RITER = -1
EITER = 0x0
RV = $ADDR
SV = PVHV\\($ADDR\\) at $ADDR
REFCNT = 2
- FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
- IV = 1 # $] < 5.009
- NV = $FLOAT # $] < 5.009
+ FLAGS = \\($PADMY,OOK,SHAREKEYS\\)
+ AUX_FLAGS = 0 # $] > 5.019008
ARRAY = $ADDR \\(0:[67],.*\\)
hash quality = [0-9.]+%
KEYS = 2
- FILL = ([12]) \\(cached = \1\\)
+ FILL = ([12])
MAX = 7
RITER = -1
EITER = 0x0
COW_REFCNT = 1
){2}');
-# This should immediately start with the FILL cached correctly.
-my %large = (0..1999);
-$b = %large;
-do_test('large hash',
- \%large,
-'SV = $RV\\($ADDR\\) at $ADDR
- REFCNT = 1
- FLAGS = \\(ROK\\)
- RV = $ADDR
- SV = PVHV\\($ADDR\\) at $ADDR
- REFCNT = 2
- FLAGS = \\(PADMY,OOK,SHAREKEYS\\)
- IV = 1 # $] < 5.009
- NV = $FLOAT # $] < 5.009
- ARRAY = $ADDR \\(0:\d+,.*\\)
- hash quality = \d+\\.\d+%
- KEYS = 1000
- FILL = (\d+) \\(cached = \1\\)
- MAX = 1023
- RITER = -1
- EITER = 0x0
- RAND = $ADDR
- Elt .*
-');
-
# Dump with arrays, hashes, and operator return values
@array = 1..3;
do_test('Dump @array', '@array', <<'ARRAY', '', '', 1);
ARRAY = $ADDR
FILL = 2
MAX = 3
- ARYLEN = 0x0
FLAGS = \(REAL\)
Elt No. 0
SV = IV\($ADDR\) at $ADDR
FLAGS = \(IOK,pIOK\)
IV = 3
ARRAY
+
+do_test('Dump @array,1', '@array,1', <<'ARRAY', '', '', 1);
+SV = PVAV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(\)
+ ARRAY = $ADDR
+ FILL = 2
+ MAX = 3
+ FLAGS = \(REAL\)
+ Elt No. 0
+ SV = IV\($ADDR\) at $ADDR
+ REFCNT = 1
+ FLAGS = \(IOK,pIOK\)
+ IV = 1
+ARRAY
+
%hash = 1..2;
do_test('Dump %hash', '%hash', <<'HASH', '', '', 1);
SV = PVHV\($ADDR\) at $ADDR
FLAGS = \(IOK,pIOK\)
IV = 2
HASH
+
$_ = "hello";
do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1);
SV = PV\($ADDR\) at $ADDR
# a way to make a better place for it:
use constant {
- perl => 'rules',
- beer => 'foamy',
+
+ # The length of the rhs string must be such that if chr() is applied to it
+ # doesn't yield a character with a backslash mnemonic. For example, if it
+ # were 'rules' instead of 'rule', it would have 5 characters, and on
+ # EBCDIC, chr(5) is \t. The dumping code would translate all the 5's in
+ # MG_PTR into "\t", and this test code would be expecting \5's, so the
+ # tests would fail. No platform that Perl works on translates chr(4) into
+ # a mnemonic.
+ perl => 'rule',
+ beer => 'foam',
};
unless ($Config{useithreads}) {
do_test('regular string constant', perl,
'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 5
- FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
- PV = $ADDR "rules"\\\0
- CUR = 5
+ FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\) # $] < 5.021005
+ FLAGS = \\(POK,(?:IsCOW,)?READONLY,pPOK\\) # $] >=5.021005
+ PV = $ADDR "rule"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
');
eval 'index "", perl';
- # FIXME - really this shouldn't say EVALED. It's a false posistive on
- # 0x40000000 being used for several things, not a flag for "I'm in a string
- # eval"
-
do_test('string constant now an FBM', perl,
'SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 5
- FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
- PV = $ADDR "rules"\\\0
- CUR = 5
+ FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\)
+ PV = $ADDR "rule"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
MAGIC = $ADDR
do_test('string constant still an FBM', perl,
'SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 5
- FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
- PV = $ADDR "rules"\\\0
- CUR = 5
+ FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\)
+ PV = $ADDR "rule"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
MAGIC = $ADDR
do_test('regular string constant', beer,
'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 6
- FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
- PV = $ADDR "foamy"\\\0
- CUR = 5
+ FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\) # $] < 5.021005
+ FLAGS = \\(POK,(?:IsCOW,)?READONLY,pPOK\\) # $] >=5.021005
+ PV = $ADDR "foam"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
');
do_test('string constant quite unaffected', beer, 'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 6
- FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\)
- PV = $ADDR "foamy"\\\0
- CUR = 5
+ FLAGS = \\(PADMY,POK,READONLY,(?:IsCOW,)?pPOK\\) # $] < 5.021005
+ FLAGS = \\(POK,(?:IsCOW,)?READONLY,pPOK\\) # $] >=5.021005
+ PV = $ADDR "foam"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
');
my $want = 'SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 6
- FLAGS = \\(PADMY,SMG,POK,READONLY,(?:IsCOW,)?pPOK,VALID,EVALED\\)
- PV = $ADDR "foamy"\\\0
- CUR = 5
+ FLAGS = \\($PADMY,SMG,POK,(?:IsCOW,)?READONLY,(?:IsCOW,)?pPOK\\)
+ PV = $ADDR "foam"\\\0
+ CUR = 4
LEN = \d+
COW_REFCNT = 0
MAGIC = $ADDR
do_test('second string also unaffected', $pie, 'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(PADMY,POK,(?:IsCOW,)?pPOK\\)
+ FLAGS = \\($PADMY,POK,(?:IsCOW,)?pPOK\\)
PV = $ADDR "good"\\\0
CUR = 4
LEN = \d+
# (One block of study tests removed when study was made a no-op.)
{
- open(OUT,">peek$$") or die "Failed to open peek $$: $!";
+ open(OUT, '>', "peek$$") or die "Failed to open peek $$: $!";
open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
DeadCode();
open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
pass "no crash with DeadCode";
close OUT;
}
-
+# note the conditionals on ENGINE and INTFLAGS were introduced in 5.19.9
do_test('UTF-8 in a regular expression',
qr/\x{100}/,
'SV = IV\($ADDR\) at $ADDR
RV = $ADDR
SV = REGEXP\($ADDR\) at $ADDR
REFCNT = 1
- FLAGS = \(OBJECT,FAKE,UTF8\)
+ FLAGS = \(OBJECT,POK,FAKE,pPOK,UTF8\)
PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
CUR = 13
STASH = $ADDR "Regexp"
COMPFLAGS = 0x0 \(\)
- EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
- INTFLAGS = 0x0
+ EXTFLAGS = $ADDR \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
+(?: ENGINE = $ADDR \(STANDARD\)
+)? INTFLAGS = 0x0(?: \(\))?
NPARENS = 0
LASTPAREN = 0
LASTCLOSEPAREN = 0
SUBOFFSET = 0
SUBCOFFSET = 0
SUBBEG = 0x0
- ENGINE = $ADDR
- MOTHER_RE = $ADDR'
+(?: ENGINE = $ADDR
+)? MOTHER_RE = $ADDR'
. ($] < 5.019003 ? '' : '
SV = REGEXP\($ADDR\) at $ADDR
REFCNT = 2
- FLAGS = \(UTF8\)
+ FLAGS = \(POK,pPOK,UTF8\)
PV = $ADDR "\(\?\^u:\\\\\\\\x\{100\}\)" \[UTF8 "\(\?\^u:\\\\\\\\x\{100\}\)"\]
CUR = 13
COMPFLAGS = 0x0 \(\)
- EXTFLAGS = 0x680040 \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
- INTFLAGS = 0x0
+ EXTFLAGS = $ADDR \(CHECK_ALL,USE_INTUIT_NOML,USE_INTUIT_ML\)
+(?: ENGINE = $ADDR \(STANDARD\)
+)? INTFLAGS = 0x0(?: \(\))?
NPARENS = 0
LASTPAREN = 0
LASTCLOSEPAREN = 0
SUBOFFSET = 0
SUBCOFFSET = 0
SUBBEG = 0x0
- ENGINE = $ADDR
- MOTHER_RE = 0x0
+(?: ENGINE = $ADDR
+)? MOTHER_RE = 0x0
PAREN_NAMES = 0x0
SUBSTRS = $ADDR
PPRIVATE = $ADDR
my $base_count = Devel::Peek::SvREFCNT(%hash);
my $ref = \%hash;
is(Devel::Peek::SvREFCNT(%hash), $base_count + 1, "SvREFCNT on non-scalar");
+ ok(!eval { &Devel::Peek::SvREFCNT(1) }, "requires prototype");
}
-
{
# utf8 tests
use utf8;
sub _dump {
- open(OUT,">peek$$") or die $!;
+ open(OUT, '>', "peek$$") or die $!;
open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
- Dump($_[1]);
+ Dump($_[0]);
open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
close(OUT);
- open(IN, "peek$$") or die $!;
+ open(IN, '<', "peek$$") or die $!;
my $dump = do { local $/; <IN> };
close(IN);
+ 1 while unlink "peek$$";
return $dump;
}
)
}
-{
- local $::TODO = "OUTSIDE currently broken in blead";
sub get_outside {
- eval "sub $_[0] { my \$x; \$x++; return sub { \$x } } $_[0]()";
-
+ eval "sub $_[0] { my \$x; \$x++; return sub { eval q{\$x} } } $_[0]()";
}
-sub food { my $x; return sub { $x } }
+sub basic { my $x; return eval q{sub { eval q{$x} }} }
like(
- _dump(food()),
+ _dump(basic()),
qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(basic)/,
'OUTSIDE works'
);
qr/OUTSIDE = 0x[[:xdigit:]]+\s+\Q(\x{30ce})/,
'OUTSIDE + UTF8 works'
);
-}
# TODO AUTOLOAD = stashname, which requires using a XS autoload
# and calling Dump() on the cv
}
+my $runperl_args = { switches => ['-Ilib'] };
sub test_DumpProg {
my ($prog, $expected, $name, $test) = @_;
$test ||= 'like';
utf8::encode($prog);
if ( $test eq 'is' ) {
- t::fresh_perl_is($prog . $u, $expected, undef, $name)
+ t::fresh_perl_is($prog . $u, $expected, $runperl_args, $name)
}
else {
- t::fresh_perl_like($prog . $u, $expected, undef, $name)
+ t::fresh_perl_like($prog . $u, $expected, $runperl_args, $name)
}
$builder->current_test(t::curr_test() - 1);
test_DumpProg(@$test);
}
-my $e = <<'EODUMP';
-dumpindent is 4 at - line 1.
{
-1 TYPE = leave ===> NULL
- TARG = 1
- FLAGS = (VOID,KIDS,PARENS,SLABBED)
- PRIVATE = (REFCOUNTED)
- REFCNT = 1
- {
-2 TYPE = enter ===> 3
- FLAGS = (UNKNOWN,SLABBED)
- }
- {
-3 TYPE = nextstate ===> 4
- FLAGS = (VOID,SLABBED)
- LINE = 1
- PACKAGE = "t"
- }
- {
-5 TYPE = entersub ===> 1
- TARG = TARGS_REPLACE
- FLAGS = (VOID,KIDS,STACKED,SLABBED)
- PRIVATE = (HASTARG)
- {
-6 TYPE = null ===> (5)
- (was list)
- FLAGS = (UNKNOWN,KIDS,SLABBED)
- {
-4 TYPE = pushmark ===> 7
- FLAGS = (SCALAR,SLABBED)
- }
- {
-8 TYPE = null ===> (6)
- (was rv2cv)
- FLAGS = (SCALAR,KIDS,SLABBED)
- {
-7 TYPE = gv ===> 5
- FLAGS = (SCALAR,SLABBED)
- GV_OR_PADIX
- }
- }
- }
- }
-}
+ local $TODO = 'This gets mangled by the current pipe implementation' if $^O eq 'VMS';
+ my $e = <<'EODUMP';
+dumpindent is 4 at -e line 1.
+
+1 leave LISTOP(0xNNN) ===> [0x0]
+ TARG = 1
+ FLAGS = (VOID,KIDS,PARENS,SLABBED)
+ PRIVATE = (REFC)
+ REFCNT = 1
+ |
+2 +--enter OP(0xNNN) ===> 3 [nextstate 0xNNN]
+ | FLAGS = (UNKNOWN,SLABBED,MORESIB)
+ |
+3 +--nextstate COP(0xNNN) ===> 4 [pushmark 0xNNN]
+ | FLAGS = (VOID,SLABBED,MORESIB)
+ | LINE = 1
+ | PACKAGE = "t"
+ | |
+5 +--entersub UNOP(0xNNN) ===> 1 [leave 0xNNN]
+ TARG = 1
+ FLAGS = (VOID,KIDS,STACKED,SLABBED)
+ PRIVATE = (TARG)
+ |
+6 +--null (ex-list) UNOP(0xNNN) ===> 5 [entersub 0xNNN]
+ FLAGS = (UNKNOWN,KIDS,SLABBED)
+ |
+4 +--pushmark OP(0xNNN) ===> 7 [gv 0xNNN]
+ | FLAGS = (SCALAR,SLABBED,MORESIB)
+ |
+8 +--null (ex-rv2cv) UNOP(0xNNN) ===> 6 [null 0xNNN]
+ FLAGS = (SCALAR,KIDS,SLABBED)
+ PRIVATE = (0x1)
+ |
+7 +--gv SVOP(0xNNN) ===> 5 [entersub 0xNNN]
+ FLAGS = (SCALAR,SLABBED)
+ GV_OR_PADIX
EODUMP
-$e =~ s/TARGS_REPLACE/$threads ? 3 : 1/e;
-$e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg"/e;
-
-test_DumpProg("package t;", $e, "DumpProg() has no 'Attempt to free X prematurely' warning", "is" );
-
+ $e =~ s/GV_OR_PADIX/$threads ? "PADIX = 2" : "GV = t::DumpProg (0xNNN)"/e;
+ $e =~ s/SVOP/PADOP/g if $threads;
+ my $out = t::runperl
+ switches => ['-Ilib'],
+ prog => 'package t; use Devel::Peek q-DumpProg-; DumpProg();',
+ stderr=>1;
+ $out =~ s/ *SEQ = .*\n//;
+ $out =~ s/0x[0-9a-f]{2,}\]/${1}0xNNN]/g;
+ $out =~ s/\(0x[0-9a-f]{3,}\)/(0xNNN)/g;
+ is $out, $e, "DumpProg() has no 'Attempt to free X prematurely' warning";
+}
done_testing();
https://perl5.git.perl.org / perl5.git / blobdiff