1N/A#!./perl -T
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require Config; import Config;
1N/A if ($Config{'extensions'} !~ /\bPeek\b/) {
1N/A print "1..0 # Skip: Devel::Peek was not built\n";
1N/A exit 0;
1N/A }
1N/A}
1N/A
1N/Ause Devel::Peek;
1N/A
1N/Aprint "1..22\n";
1N/A
1N/Aour $DEBUG = 0;
1N/Aopen(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
1N/A
1N/Asub do_test {
1N/A my $pattern = pop;
1N/A if (open(OUT,">peek$$")) {
1N/A open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
1N/A Dump($_[1]);
1N/A open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
1N/A close(OUT);
1N/A if (open(IN, "peek$$")) {
1N/A local $/;
1N/A $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
1N/A $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
1N/A print $pattern, "\n" if $DEBUG;
1N/A my $dump = <IN>;
1N/A print $dump, "\n" if $DEBUG;
1N/A print "got:\n[\n$dump\n]\nexpected:\n[\n$pattern\n]\nnot "
1N/A unless $dump =~ /\A$pattern\Z/ms;
1N/A print "ok $_[0]\n";
1N/A close(IN);
1N/A return $1;
1N/A } else {
1N/A die "$0: failed to open peek$$: !\n";
1N/A }
1N/A } else {
1N/A die "$0: failed to create peek$$: $!\n";
1N/A }
1N/A}
1N/A
1N/Aour $a;
1N/Aour $b;
1N/Amy $c;
1N/Alocal $d = 0;
1N/A
1N/Ado_test( 1,
1N/A $a = "foo",
1N/A'SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(POK,pPOK\\)
1N/A PV = $ADDR "foo"\\\0
1N/A CUR = 3
1N/A LEN = \\d+'
1N/A );
1N/A
1N/Ado_test( 2,
1N/A "bar",
1N/A'SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(.*POK,READONLY,pPOK\\)
1N/A PV = $ADDR "bar"\\\0
1N/A CUR = 3
1N/A LEN = \\d+');
1N/A
1N/Ado_test( 3,
1N/A $b = 123,
1N/A'SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(IOK,pIOK\\)
1N/A IV = 123');
1N/A
1N/Ado_test( 4,
1N/A 456,
1N/A'SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(.*IOK,READONLY,pIOK\\)
1N/A IV = 456');
1N/A
1N/Ado_test( 5,
1N/A $c = 456,
1N/A'SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
1N/A IV = 456');
1N/A
1N/A# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
1N/A# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
1N/A# maths is done in floating point always, and this scalar will be an NV.
1N/A# ([NI]) captures the type, referred to by \1 in this regexp and $type for
1N/A# building subsequent regexps.
1N/Amy $type = do_test( 6,
1N/A $c + $d,
1N/A'SV = ([NI])V\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(PADTMP,\1OK,p\1OK\\)
1N/A \1V = 456');
1N/A
1N/A($d = "789") += 0.1;
1N/A
1N/Ado_test( 7,
1N/A $d,
1N/A'SV = PVNV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(NOK,pNOK\\)
1N/A IV = 0
1N/A NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
1N/A PV = $ADDR "789"\\\0
1N/A CUR = 3
1N/A LEN = \\d+');
1N/A
1N/Ado_test( 8,
1N/A 0xabcd,
1N/A'SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(.*IOK,READONLY,pIOK\\)
1N/A IV = 43981');
1N/A
1N/Ado_test( 9,
1N/A undef,
1N/A'SV = NULL\\(0x0\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(\\)');
1N/A
1N/Ado_test(10,
1N/A \$a,
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(POK,pPOK\\)
1N/A PV = $ADDR "foo"\\\0
1N/A CUR = 3
1N/A LEN = \\d+');
1N/A
1N/Amy $c_pattern;
1N/Aif ($type eq 'N') {
1N/A $c_pattern = '
1N/A SV = PVNV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
1N/A IV = 456
1N/A NV = 456
1N/A PV = 0';
1N/A} else {
1N/A $c_pattern = '
1N/A SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(IOK,pIOK\\)
1N/A IV = 456';
1N/A}
1N/Ado_test(11,
1N/A [$b,$c],
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVAV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(\\)
1N/A IV = 0
1N/A NV = 0
1N/A ARRAY = $ADDR
1N/A FILL = 1
1N/A MAX = 1
1N/A ARYLEN = 0x0
1N/A FLAGS = \\(REAL\\)
1N/A Elt No. 0
1N/A SV = IV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(IOK,pIOK\\)
1N/A IV = 123
1N/A Elt No. 1' . $c_pattern);
1N/A
1N/Ado_test(12,
1N/A {$b=>$c},
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVHV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(SHAREKEYS\\)
1N/A IV = 1
1N/A NV = $FLOAT
1N/A ARRAY = $ADDR \\(0:7, 1:1\\)
1N/A hash quality = 100.0%
1N/A KEYS = 1
1N/A FILL = 1
1N/A MAX = 7
1N/A RITER = -1
1N/A EITER = 0x0
1N/A Elt "123" HASH = $ADDR' . $c_pattern);
1N/A
1N/Ado_test(13,
1N/A sub(){@_},
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVCV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
1N/A IV = 0
1N/A NV = 0
1N/A PROTOTYPE = ""
1N/A COMP_STASH = $ADDR\\t"main"
1N/A START = $ADDR ===> \\d+
1N/A ROOT = $ADDR
1N/A XSUB = 0x0
1N/A XSUBANY = 0
1N/A GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
1N/A FILE = ".*\\b(?i:peek\\.t)"
1N/A DEPTH = 0
1N/A(?: MUTEXP = $ADDR
1N/A OWNER = $ADDR
1N/A)? FLAGS = 0x404
1N/A OUTSIDE_SEQ = \\d+
1N/A PADLIST = $ADDR
1N/A PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
1N/A OUTSIDE = $ADDR \\(MAIN\\)');
1N/A
1N/Ado_test(14,
1N/A \&do_test,
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVCV\\($ADDR\\) at $ADDR
1N/A REFCNT = (3|4)
1N/A FLAGS = \\(\\)
1N/A IV = 0
1N/A NV = 0
1N/A COMP_STASH = $ADDR\\t"main"
1N/A START = $ADDR ===> \\d+
1N/A ROOT = $ADDR
1N/A XSUB = 0x0
1N/A XSUBANY = 0
1N/A GVGV::GV = $ADDR\\t"main" :: "do_test"
1N/A FILE = ".*\\b(?i:peek\\.t)"
1N/A DEPTH = 1
1N/A(?: MUTEXP = $ADDR
1N/A OWNER = $ADDR
1N/A)? FLAGS = 0x0
1N/A OUTSIDE_SEQ = \\d+
1N/A PADLIST = $ADDR
1N/A PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
1N/A \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
1N/A \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG"
1N/A \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
1N/A OUTSIDE = $ADDR \\(MAIN\\)');
1N/A
1N/Ado_test(15,
1N/A qr(tic),
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVMG\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(OBJECT,SMG\\)
1N/A IV = 0
1N/A NV = 0
1N/A PV = 0
1N/A MAGIC = $ADDR
1N/A MG_VIRTUAL = $ADDR
1N/A MG_TYPE = PERL_MAGIC_qr\(r\)
1N/A MG_OBJ = $ADDR
1N/A STASH = $ADDR\\t"Regexp"');
1N/A
1N/Ado_test(16,
1N/A (bless {}, "Tac"),
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVHV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(OBJECT,SHAREKEYS\\)
1N/A IV = 0
1N/A NV = 0
1N/A STASH = $ADDR\\t"Tac"
1N/A ARRAY = 0x0
1N/A KEYS = 0
1N/A FILL = 0
1N/A MAX = 7
1N/A RITER = -1
1N/A EITER = 0x0');
1N/A
1N/Ado_test(17,
1N/A *a,
1N/A'SV = PVGV\\($ADDR\\) at $ADDR
1N/A REFCNT = 5
1N/A FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
1N/A IV = 0
1N/A NV = 0
1N/A MAGIC = $ADDR
1N/A MG_VIRTUAL = &PL_vtbl_glob
1N/A MG_TYPE = PERL_MAGIC_glob\(\*\)
1N/A MG_OBJ = $ADDR
1N/A NAME = "a"
1N/A NAMELEN = 1
1N/A GvSTASH = $ADDR\\t"main"
1N/A GP = $ADDR
1N/A SV = $ADDR
1N/A REFCNT = 1
1N/A IO = 0x0
1N/A FORM = 0x0
1N/A AV = 0x0
1N/A HV = 0x0
1N/A CV = 0x0
1N/A CVGEN = 0x0
1N/A GPFLAGS = 0x0
1N/A LINE = \\d+
1N/A FILE = ".*\\b(?i:peek\\.t)"
1N/A FLAGS = $ADDR
1N/A EGV = $ADDR\\t"a"');
1N/A
1N/Aif (ord('A') == 193) {
1N/Ado_test(18,
1N/A chr(256).chr(0).chr(512),
1N/A'SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
1N/A PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
1N/A CUR = 5
1N/A LEN = \\d+');
1N/A} else {
1N/Ado_test(18,
1N/A chr(256).chr(0).chr(512),
1N/A'SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\((?:PADBUSY,PADTMP,)?POK,READONLY,pPOK,UTF8\\)
1N/A PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
1N/A CUR = 5
1N/A LEN = \\d+');
1N/A}
1N/A
1N/Aif (ord('A') == 193) {
1N/Ado_test(19,
1N/A {chr(256)=>chr(512)},
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVHV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1N/A UV = 1
1N/A NV = $FLOAT
1N/A ARRAY = $ADDR \\(0:7, 1:1\\)
1N/A hash quality = 100.0%
1N/A KEYS = 1
1N/A FILL = 1
1N/A MAX = 7
1N/A RITER = -1
1N/A EITER = $ADDR
1N/A Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
1N/A SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(POK,pPOK,UTF8\\)
1N/A PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
1N/A CUR = 2
1N/A LEN = \\d+');
1N/A} else {
1N/Ado_test(19,
1N/A {chr(256)=>chr(512)},
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVHV\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
1N/A UV = 1
1N/A NV = 0
1N/A ARRAY = $ADDR \\(0:7, 1:1\\)
1N/A hash quality = 100.0%
1N/A KEYS = 1
1N/A FILL = 1
1N/A MAX = 7
1N/A RITER = -1
1N/A EITER = $ADDR
1N/A Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
1N/A SV = PV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(POK,pPOK,UTF8\\)
1N/A PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
1N/A CUR = 2
1N/A LEN = \\d+');
1N/A}
1N/A
1N/Amy $x="";
1N/A$x=~/.??/g;
1N/Ado_test(20,
1N/A $x,
1N/A'SV = PVMG\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(PADBUSY,PADMY,SMG,POK,pPOK\\)
1N/A IV = 0
1N/A NV = 0
1N/A PV = $ADDR ""\\\0
1N/A CUR = 0
1N/A LEN = 1
1N/A MAGIC = $ADDR
1N/A MG_VIRTUAL = &PL_vtbl_mglob
1N/A MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
1N/A MG_FLAGS = 0x01
1N/A MINMATCH');
1N/A
1N/A#
1N/A# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
1N/A# environment variables may be invisibly case-forced, hence the (?i:PATH)
1N/A# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
1N/A#
1N/Ado_test(21,
1N/A $ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
1N/A'SV = PVMG\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
1N/A IV = 0
1N/A NV = 0
1N/A PV = $ADDR "0"\\\0
1N/A CUR = 1
1N/A LEN = \d+
1N/A MAGIC = $ADDR
1N/A MG_VIRTUAL = &PL_vtbl_envelem
1N/A MG_TYPE = PERL_MAGIC_envelem\\(e\\)
1N/A(?: MG_FLAGS = 0x01
1N/A TAINTEDDIR
1N/A)? MG_LEN = -?\d+
1N/A MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
1N/A SV = PV(?:IV)?\\($ADDR\\) at $ADDR
1N/A REFCNT = \d+
1N/A FLAGS = \\(TEMP,POK,pPOK\\)
1N/A(?: IV = 0
1N/A)? PV = $ADDR "(?i:PATH)"\\\0
1N/A CUR = \d+
1N/A LEN = \d+)
1N/A MAGIC = $ADDR
1N/A MG_VIRTUAL = &PL_vtbl_taint
1N/A MG_TYPE = PERL_MAGIC_taint\\(t\\)');
1N/A
1N/AEND {
1N/A 1 while unlink("peek$$");
1N/A}
1N/A
1N/A# blessed refs
1N/Ado_test(22,
1N/A bless(\\undef, 'Foobar'),
1N/A'SV = RV\\($ADDR\\) at $ADDR
1N/A REFCNT = 1
1N/A FLAGS = \\(ROK\\)
1N/A RV = $ADDR
1N/A SV = PVMG\\($ADDR\\) at $ADDR
1N/A REFCNT = 2
1N/A FLAGS = \\(OBJECT,ROK\\)
1N/A IV = -?\d+
1N/A NV = $FLOAT
1N/A RV = $ADDR
1N/A SV = NULL\\(0x0\\) at $ADDR
1N/A REFCNT = \d+
1N/A FLAGS = \\(READONLY\\)
1N/A PV = $ADDR ""
1N/A CUR = 0
1N/A LEN = 0
1N/A STASH = $ADDR\s+"Foobar"');