+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bPeek\b/) {
+ print "1..0 # Skip: Devel::Peek was not built\n";
+ exit 0;
+ }
+}
+
use Devel::Peek;
print "1..17\n";
our $DEBUG = 0;
+open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
sub do_test {
my $pattern = pop;
if (open(OUT,">peek$$")) {
- open(STDERR,">&OUT");
+ open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
Dump($_[1]);
+ open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
close(OUT);
if (open(IN, "peek$$")) {
local $/;
print $pattern, "\n" if $DEBUG;
my $dump = <IN>;
print $dump, "\n" if $DEBUG;
- print "not " unless $dump =~ /$pattern/m;
+ print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
print "ok $_[0]\n";
close(IN);
} else {
our $a;
our $b;
my $c;
-local $d;
+local $d = 0;
do_test( 1,
$a = "foo",
"bar",
'SV = PV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(POK,READONLY,pPOK\\)
+ FLAGS = \\(.*POK,READONLY,pPOK\\)
PV = $ADDR "bar"\\\0
CUR = 3
LEN = 4');
456,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,READONLY,pIOK\\)
+ FLAGS = \\(.*IOK,READONLY,pIOK\\)
IV = 456');
do_test( 5,
do_test( 6,
$c + $d,
-'SV = NV\\($ADDR\\) at $ADDR
+'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(PADTMP,NOK,pNOK\\)
- NV = 456');
+ FLAGS = \\(PADTMP,IOK,pIOK\\)
+ IV = 456');
($d = "789") += 0.1;
REFCNT = 1
FLAGS = \\(NOK,pNOK\\)
IV = 0
- NV = 789\\.1
+ NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
PV = $ADDR "789"\\\0
CUR = 3
LEN = 4');
0xabcd,
'SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,READONLY,pIOK,IsUV\\)
- UV = 43981');
+ FLAGS = \\(.*IOK,READONLY,pIOK\\)
+ IV = 43981');
do_test( 9,
undef,
FLAGS = \\(IOK,pIOK\\)
IV = 123
Elt No. 1
- SV = PVNV\\($ADDR\\) at $ADDR
+ SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
- IV = 456
- NV = 456
- PV = 0');
+ FLAGS = \\(IOK,pIOK\\)
+ IV = 456');
do_test(12,
{$b=>$c},
IV = 1
NV = 0
ARRAY = $ADDR \\(0:7, 1:1\\)
- hash quality = 150.0%
+ hash quality = 100.0%
KEYS = 1
FILL = 1
MAX = 7
RITER = -1
EITER = 0x0
Elt "123" HASH = $ADDR
- SV = PVNV\\($ADDR\\) at $ADDR
+ SV = IV\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
- IV = 456
- NV = 456
- PV = 0');
+ FLAGS = \\(IOK,pIOK\\)
+ IV = 456');
do_test(13,
sub(){@_},
ROOT = $ADDR
XSUB = 0x0
XSUBANY = 0
- GVGV::GV = $ADDR\\t"main" :: "__ANON__"
- FILE = ".+\\b(?i:peek\\.t)"
+ GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
+ FILE = ".*\\b(?i:peek\\.t)"
DEPTH = 0
- FLAGS = 0x4
+(?: MUTEXP = $ADDR
+ OWNER = $ADDR
+)? FLAGS = 0x4
PADLIST = $ADDR
OUTSIDE = $ADDR \\(MAIN\\)');
FLAGS = \\(ROK\\)
RV = $ADDR
SV = PVCV\\($ADDR\\) at $ADDR
- REFCNT = 3
+ REFCNT = (3|4)
FLAGS = \\(\\)
IV = 0
NV = 0
XSUB = 0x0
XSUBANY = 0
GVGV::GV = $ADDR\\t"main" :: "do_test"
- FILE = ".+\\b(?i:peek\\.t)"
+ FILE = ".*\\b(?i:peek\\.t)"
DEPTH = 1
- FLAGS = 0x0
+(?: MUTEXP = $ADDR
+ OWNER = $ADDR
+)? FLAGS = 0x0
PADLIST = $ADDR
- 1\\. $ADDR \\("\\$pattern" 49-57\\)
- 12\\. $ADDR \\(FAKE "\\$DEBUG" 0-51\\)
- 13\\. $ADDR \\("\\$dump" 50-51\\)
+ \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
+ \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
+ \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
OUTSIDE = $ADDR \\(MAIN\\)');
do_test(15,
*a,
'SV = PVGV\\($ADDR\\) at $ADDR
REFCNT = 5
- FLAGS = \\(GMG,SMG,MULTI\\)
+ FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
IV = 0
NV = 0
MAGIC = $ADDR
MG_VIRTUAL = &PL_vtbl_glob
MG_TYPE = \'\\*\'
MG_OBJ = $ADDR
- MG_LEN = 1
- MG_PTR = $ADDR "a"
NAME = "a"
NAMELEN = 1
GvSTASH = $ADDR\\t"main"
CV = 0x0
CVGEN = 0x0
GPFLAGS = 0x0
- LINE = 30
- FILE = ".+\\b(?i:peek\\.t)"
- FLAGS = 0x2
+ LINE = \\d+
+ FILE = ".*\\b(?i:peek\\.t)"
+ FLAGS = $ADDR
EGV = $ADDR\\t"a"');
END {
- unlink("peek$$");
+ 1 while unlink("peek$$");
}