[p5sagit/p5-mst-13.2.git] / ext / Devel / Peek / t / Peek.t

#!./perl -T

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..23\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") or die "Can't dup OUT: $!";
	Dump($_[1]);
	open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
	close(OUT);
	if (open(IN, "peek$$")) {
	    local $/;
	    $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
	    $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
	    # handle DEBUG_LEAKING_SCALARS prefix
	    $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;

	    $pattern =~ s/^ *\$XSUB *\n/
		($] < 5.009) ? "    XSUB = 0\n    XSUBANY = 0\n" : '';
	    /mge;
	    $pattern =~ s/^ *\$ROOT *\n/
		($] < 5.009) ? "    ROOT = 0x0\n" : '';
	    /mge;


	    print $pattern, "\n" if $DEBUG;
	    my $dump = <IN>;
	    print $dump, "\n"    if $DEBUG;
	    print "got:\n[\n$dump\n]\nexpected:\n[\n$pattern\n]\nnot "
		unless $dump =~ /\A$pattern\Z/ms;
	    print "ok $_[0]\n";
	    close(IN);
            return $1;
	} else {
	    die "$0: failed to open peek$$: !\n";
	}
    } else {
	die "$0: failed to create peek$$: $!\n";
    }
}

our   $a;
our   $b;
my    $c;
local $d = 0;


do_test( 1,
	$a = "foo",
'SV = PV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(POK,pPOK\\)
  PV = $ADDR "foo"\\\0
  CUR = 3
  LEN = \\d+'
       );

do_test( 2,
        "bar",
'SV = PV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(.*POK,READONLY,pPOK\\)
  PV = $ADDR "bar"\\\0
  CUR = 3
  LEN = \\d+');

do_test( 3,
        $b = 123,
'SV = IV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(IOK,pIOK\\)
  IV = 123');

do_test( 4,
        456,
'SV = IV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(.*IOK,READONLY,pIOK\\)
  IV = 456');

do_test( 5,
        $c = 456,
'SV = IV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(PADMY,IOK,pIOK\\)
  IV = 456');

# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
# maths is done in floating point always, and this scalar will be an NV.
# ([NI]) captures the type, referred to by \1 in this regexp and $type for
# building subsequent regexps.
my $type = do_test( 6,
        $c + $d,
'SV = ([NI])V\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(PADTMP,\1OK,p\1OK\\)
  \1V = 456');

($d = "789") += 0.1;

do_test( 7,
       $d,
'SV = PVNV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(NOK,pNOK\\)
  IV = 0
  NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
  PV = $ADDR "789"\\\0
  CUR = 3
  LEN = \\d+');

do_test( 8,
        0xabcd,
'SV = IV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(.*IOK,READONLY,pIOK\\)
  IV = 43981');

do_test( 9,
        undef,
'SV = NULL\\(0x0\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(\\)');

do_test(10,
        \$a,
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(POK,pPOK\\)
    PV = $ADDR "foo"\\\0
    CUR = 3
    LEN = \\d+');

my $c_pattern;
if ($type eq 'N') {
  $c_pattern = '
    SV = PVNV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
      IV = 456
      NV = 456
      PV = 0';
} else {
  $c_pattern = '
    SV = IV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(IOK,pIOK\\)
      IV = 456';
}
do_test(11,
       [$b,$c],
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVAV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(\\)
    ARRAY = $ADDR
    FILL = 1
    MAX = 1
    ARYLEN = 0x0
    FLAGS = \\(REAL\\)
    Elt No. 0
    SV = IV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(IOK,pIOK\\)
      IV = 123
    Elt No. 1' . $c_pattern);

do_test(12,
       {$b=>$c},
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVHV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(SHAREKEYS\\)
    ARRAY = $ADDR  \\(0:7, 1:1\\)
    hash quality = 100.0%
    KEYS = 1
    FILL = 1
    MAX = 7
    RITER = -1
    EITER = 0x0
    Elt "123" HASH = $ADDR' . $c_pattern);

do_test(13,
        sub(){@_},
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVCV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
    NV = 0
    PROTOTYPE = ""
    COMP_STASH = $ADDR\\t"main"
    START = $ADDR ===> \\d+
    ROOT = $ADDR
    $XSUB
    GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
    FILE = ".*\\b(?i:peek\\.t)"
    DEPTH = 0
(?:    MUTEXP = $ADDR
    OWNER = $ADDR
)?    FLAGS = 0x90
    OUTSIDE_SEQ = \\d+
    PADLIST = $ADDR
    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
    OUTSIDE = $ADDR \\(MAIN\\)');

do_test(14,
        \&do_test,
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVCV\\($ADDR\\) at $ADDR
    REFCNT = (3|4)
    FLAGS = \\(\\)
    NV = 0
    COMP_STASH = $ADDR\\t"main"
    START = $ADDR ===> \\d+
    ROOT = $ADDR
    $XSUB
    GVGV::GV = $ADDR\\t"main" :: "do_test"
    FILE = ".*\\b(?i:peek\\.t)"
    DEPTH = 1
(?:    MUTEXP = $ADDR
    OWNER = $ADDR
)?    FLAGS = 0x0
    OUTSIDE_SEQ = \\d+
    PADLIST = $ADDR
    PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
       \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
      \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0
      \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
    OUTSIDE = $ADDR \\(MAIN\\)');

do_test(15,
        qr(tic),
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVMG\\($ADDR\\) at $ADDR
    REFCNT = 1
    FLAGS = \\(OBJECT,SMG\\)
    IV = 0
    NV = 0
    PV = 0
    MAGIC = $ADDR
      MG_VIRTUAL = $ADDR
      MG_TYPE = PERL_MAGIC_qr\(r\)
      MG_OBJ = $ADDR
    STASH = $ADDR\\t"Regexp"');

do_test(16,
        (bless {}, "Tac"),
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVHV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(OBJECT,SHAREKEYS\\)
    STASH = $ADDR\\t"Tac"
    ARRAY = 0x0
    KEYS = 0
    FILL = 0
    MAX = 7
    RITER = -1
    EITER = 0x0');

do_test(17,
	*a,
'SV = PVGV\\($ADDR\\) at $ADDR
  REFCNT = 5
  FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
  IV = 0
  NV = 0
  MAGIC = $ADDR
    MG_VIRTUAL = &PL_vtbl_glob
    MG_TYPE = PERL_MAGIC_glob\(\*\)
    MG_OBJ = $ADDR
  NAME = "a"
  NAMELEN = 1
  GvSTASH = $ADDR\\t"main"
  GP = $ADDR
    SV = $ADDR
    REFCNT = 1
    IO = 0x0
    FORM = 0x0  
    AV = 0x0
    HV = 0x0
    CV = 0x0
    CVGEN = 0x0
    LINE = \\d+
    FILE = ".*\\b(?i:peek\\.t)"
    FLAGS = $ADDR
    EGV = $ADDR\\t"a"');

if (ord('A') == 193) {
do_test(18,
	chr(256).chr(0).chr(512),
'SV = PV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
  PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
  CUR = 5
  LEN = \\d+');
} else {
do_test(18,
	chr(256).chr(0).chr(512),
'SV = PV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
  PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
  CUR = 5
  LEN = \\d+');
}

if (ord('A') == 193) {
do_test(19,
	{chr(256)=>chr(512)},
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVHV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
    ARRAY = $ADDR  \\(0:7, 1:1\\)
    hash quality = 100.0%
    KEYS = 1
    FILL = 1
    MAX = 7
    RITER = -1
    EITER = $ADDR
    Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
    SV = PV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(POK,pPOK,UTF8\\)
      PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
      CUR = 2
      LEN = \\d+');
} else {
do_test(19,
	{chr(256)=>chr(512)},
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVHV\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
    ARRAY = $ADDR  \\(0:7, 1:1\\)
    hash quality = 100.0%
    KEYS = 1
    FILL = 1
    MAX = 7
    RITER = -1
    EITER = $ADDR
    Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
    SV = PV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(POK,pPOK,UTF8\\)
      PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
      CUR = 2
      LEN = \\d+');
}

my $x="";
$x=~/.??/g;
do_test(20,
        $x,
'SV = PVMG\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(PADMY,SMG,POK,pPOK\\)
  IV = 0
  NV = 0
  PV = $ADDR ""\\\0
  CUR = 0
  LEN = \d+
  MAGIC = $ADDR
    MG_VIRTUAL = &PL_vtbl_mglob
    MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
    MG_FLAGS = 0x01
      MINMATCH');

#
# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
# environment variables may be invisibly case-forced, hence the (?i:PATH)
# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
# VMS is setting FAKE and READONLY flags.  What VMS uses for storing
# ENV hashes is also not always null terminated.
#
do_test(21,
        $ENV{PATH}=@ARGV,  # scalar(@ARGV) is a handy known tainted value
'SV = PVMG\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
  IV = 0
  NV = 0
  PV = $ADDR "0"\\\0
  CUR = 1
  LEN = \d+
  MAGIC = $ADDR
    MG_VIRTUAL = &PL_vtbl_envelem
    MG_TYPE = PERL_MAGIC_envelem\\(e\\)
(?:    MG_FLAGS = 0x01
      TAINTEDDIR
)?    MG_LEN = -?\d+
    MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
    SV = PV(?:IV)?\\($ADDR\\) at $ADDR
      REFCNT = \d+
      FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
(?:      IV = 0
)?      PV = $ADDR "(?i:PATH)"(?:\\\0)?
      CUR = \d+
      LEN = \d+)
  MAGIC = $ADDR
    MG_VIRTUAL = &PL_vtbl_taint
    MG_TYPE = PERL_MAGIC_taint\\(t\\)');

END {
  1 while unlink("peek$$");
}

# blessed refs
do_test(22,
	bless(\\undef, 'Foobar'),
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVMG\\($ADDR\\) at $ADDR
    REFCNT = 2
    FLAGS = \\(OBJECT,ROK\\)
    IV = -?\d+
    NV = $FLOAT
    RV = $ADDR
    SV = NULL\\(0x0\\) at $ADDR
      REFCNT = \d+
      FLAGS = \\(READONLY\\)
    PV = $ADDR ""
    CUR = 0
    LEN = 0
    STASH = $ADDR\s+"Foobar"');

# Constant subroutines

sub const () {
    "Perl rules";
}

do_test(23,
	\&const,
'SV = RV\\($ADDR\\) at $ADDR
  REFCNT = 1
  FLAGS = \\(ROK\\)
  RV = $ADDR
  SV = PVCV\\($ADDR\\) at $ADDR
    REFCNT = (2)
    FLAGS = \\(POK,pPOK,CONST\\)
    NV = 0
    PROTOTYPE = ""
    COMP_STASH = 0x0
    $ROOT
    XSUB = $ADDR
    XSUBANY = $ADDR \\(CONST SV\\)
    SV = PV\\($ADDR\\) at $ADDR
      REFCNT = 1
      FLAGS = \\(.*POK,READONLY,pPOK\\)
      PV = $ADDR "Perl rules"\\\0
      CUR = 10
      LEN = \\d+
    GVGV::GV = $ADDR\\t"main" :: "const"
    FILE = ".*\\b(?i:peek\\.t)"
    DEPTH = 0
(?:    MUTEXP = $ADDR
    OWNER = $ADDR
)?    FLAGS = 0x1400
    OUTSIDE_SEQ = 0
    PADLIST = 0x0
    OUTSIDE = 0x0 \\(null\\)');
Commit	Line	Data
99331854	1	#!./perl -T
9ec58fb7	2
	3	BEGIN {
	4	chdir 't' if -d 't';
20822f61	5	@INC = '../lib';
9ec58fb7	6	require Config; import Config;
	7	if ($Config{'extensions'} !~ /\bPeek\b/) {
	8	print "1..0 # Skip: Devel::Peek was not built\n";
	9	exit 0;
	10	}
	11	}
	12
9248c45a	13	use Devel::Peek;
9248c45a	14
b1886099	15	print "1..23\n";
9248c45a	16
9248c45a	17	our $DEBUG = 0;
277ddfaf	18	open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
9248c45a	19
bf53b3a5	20
9248c45a	21	sub do_test {
9248c45a	22	my $pattern = pop;
277ddfaf	23	if (open(OUT,">peek$$")) {
277ddfaf	24	open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
9248c45a	25	Dump($_[1]);
277ddfaf	26	open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
277ddfaf	27	close(OUT);
9248c45a	28	if (open(IN, "peek$$")) {
	29	local $/;
	30	$pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
8aacddc1	31	$pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?\|\\d+)/g;
fd0854ff	32	# handle DEBUG_LEAKING_SCALARS prefix
d94a5950	33	$pattern =~ s/^(\s)(SV =. at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg;
bf53b3a5	34
d04ba589	35	$pattern =~ s/^ \$XSUB \n/
d04ba589	36	($] < 5.009) ? " XSUB = 0\n XSUBANY = 0\n" : '';
bf53b3a5	37	/mge;
d04ba589	38	$pattern =~ s/^ \$ROOT \n/
	39	($] < 5.009) ? " ROOT = 0x0\n" : '';
	40	/mge;
	41
bf53b3a5	42
bf53b3a5	43
9248c45a	44	print $pattern, "\n" if $DEBUG;
	45	my $dump = <IN>;
	46	print $dump, "\n" if $DEBUG;
dc3aa7ec	47	print "got:\n[\n$dump\n]\nexpected:\n[\n$pattern\n]\nnot "
dc3aa7ec	48	unless $dump =~ /\A$pattern\Z/ms;
9248c45a	49	print "ok $_[0]\n";
9248c45a	50	close(IN);
59d8ce62	51	return $1;
9248c45a	52	} else {
	53	die "$0: failed to open peek$$: !\n";
	54	}
	55	} else {
	56	die "$0: failed to create peek$$: $!\n";
	57	}
	58	}
	59
	60	our $a;
	61	our $b;
	62	my $c;
208edb77	63	local $d = 0;
9248c45a	64
bf53b3a5	65
9248c45a	66	do_test( 1,
	67	$a = "foo",
	68	'SV = PV\\($ADDR\\) at $ADDR
	69	REFCNT = 1
	70	FLAGS = \\(POK,pPOK\\)
	71	PV = $ADDR "foo"\\\0
	72	CUR = 3
1badabf5	73	LEN = \\d+'
9248c45a	74	);
	75
	76	do_test( 2,
	77	"bar",
	78	'SV = PV\\($ADDR\\) at $ADDR
	79	REFCNT = 1
7766e686	80	FLAGS = \\(.*POK,READONLY,pPOK\\)
9248c45a	81	PV = $ADDR "bar"\\\0
9248c45a	82	CUR = 3
1badabf5	83	LEN = \\d+');
9248c45a	84
	85	do_test( 3,
	86	$b = 123,
	87	'SV = IV\\($ADDR\\) at $ADDR
	88	REFCNT = 1
	89	FLAGS = \\(IOK,pIOK\\)
	90	IV = 123');
	91
	92	do_test( 4,
	93	456,
	94	'SV = IV\\($ADDR\\) at $ADDR
	95	REFCNT = 1
7766e686	96	FLAGS = \\(.*IOK,READONLY,pIOK\\)
9248c45a	97	IV = 456');
	98
	99	do_test( 5,
	100	$c = 456,
	101	'SV = IV\\($ADDR\\) at $ADDR
	102	REFCNT = 1
235cc2e3	103	FLAGS = \\(PADMY,IOK,pIOK\\)
9248c45a	104	IV = 456');
9248c45a	105
59d8ce62	106	# If perl is built with PERL_PRESERVE_IVUV then maths is done as integers
	107	# where possible and this scalar will be an IV. If NO_PERL_PRESERVE_IVUV then
	108	# maths is done in floating point always, and this scalar will be an NV.
	109	# ([NI]) captures the type, referred to by \1 in this regexp and $type for
	110	# building subsequent regexps.
	111	my $type = do_test( 6,
9248c45a	112	$c + $d,
59d8ce62	113	'SV = ([NI])V\\($ADDR\\) at $ADDR
9248c45a	114	REFCNT = 1
59d8ce62	115	FLAGS = \\(PADTMP,\1OK,p\1OK\\)
59d8ce62	116	\1V = 456');
9248c45a	117
	118	($d = "789") += 0.1;
	119
	120	do_test( 7,
	121	$d,
	122	'SV = PVNV\\($ADDR\\) at $ADDR
	123	REFCNT = 1
	124	FLAGS = \\(NOK,pNOK\\)
	125	IV = 0
ac634a9a	126	NV = 789\\.(?:1(?:000+\d+)?\|0999+\d+)
9248c45a	127	PV = $ADDR "789"\\\0
9248c45a	128	CUR = 3
1badabf5	129	LEN = \\d+');
9248c45a	130
	131	do_test( 8,
	132	0xabcd,
	133	'SV = IV\\($ADDR\\) at $ADDR
	134	REFCNT = 1
28e5dec8	135	FLAGS = \\(.*IOK,READONLY,pIOK\\)
28e5dec8	136	IV = 43981');
9248c45a	137
	138	do_test( 9,
	139	undef,
	140	'SV = NULL\\(0x0\\) at $ADDR
	141	REFCNT = 1
	142	FLAGS = \\(\\)');
	143
	144	do_test(10,
	145	\$a,
	146	'SV = RV\\($ADDR\\) at $ADDR
	147	REFCNT = 1
	148	FLAGS = \\(ROK\\)
	149	RV = $ADDR
	150	SV = PV\\($ADDR\\) at $ADDR
	151	REFCNT = 2
	152	FLAGS = \\(POK,pPOK\\)
	153	PV = $ADDR "foo"\\\0
	154	CUR = 3
1badabf5	155	LEN = \\d+');
9248c45a	156
59d8ce62	157	my $c_pattern;
	158	if ($type eq 'N') {
	159	$c_pattern = '
	160	SV = PVNV\\($ADDR\\) at $ADDR
	161	REFCNT = 1
	162	FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
	163	IV = 456
	164	NV = 456
	165	PV = 0';
	166	} else {
	167	$c_pattern = '
	168	SV = IV\\($ADDR\\) at $ADDR
	169	REFCNT = 1
	170	FLAGS = \\(IOK,pIOK\\)
	171	IV = 456';
	172	}
9248c45a	173	do_test(11,
	174	[$b,$c],
	175	'SV = RV\\($ADDR\\) at $ADDR
	176	REFCNT = 1
	177	FLAGS = \\(ROK\\)
	178	RV = $ADDR
	179	SV = PVAV\\($ADDR\\) at $ADDR
	180	REFCNT = 2
	181	FLAGS = \\(\\)
9248c45a	182	ARRAY = $ADDR
	183	FILL = 1
	184	MAX = 1
	185	ARYLEN = 0x0
	186	FLAGS = \\(REAL\\)
	187	Elt No. 0
	188	SV = IV\\($ADDR\\) at $ADDR
	189	REFCNT = 1
	190	FLAGS = \\(IOK,pIOK\\)
	191	IV = 123
59d8ce62	192	Elt No. 1' . $c_pattern);
9248c45a	193
	194	do_test(12,
	195	{$b=>$c},
	196	'SV = RV\\($ADDR\\) at $ADDR
	197	REFCNT = 1
	198	FLAGS = \\(ROK\\)
	199	RV = $ADDR
	200	SV = PVHV\\($ADDR\\) at $ADDR
	201	REFCNT = 2
	202	FLAGS = \\(SHAREKEYS\\)
9248c45a	203	ARRAY = $ADDR \\(0:7, 1:1\\)
b8fa94d8	204	hash quality = 100.0%
9248c45a	205	KEYS = 1
	206	FILL = 1
	207	MAX = 7
	208	RITER = -1
	209	EITER = 0x0
59d8ce62	210	Elt "123" HASH = $ADDR' . $c_pattern);
9248c45a	211
	212	do_test(13,
	213	sub(){@_},
	214	'SV = RV\\($ADDR\\) at $ADDR
	215	REFCNT = 1
	216	FLAGS = \\(ROK\\)
	217	RV = $ADDR
	218	SV = PVCV\\($ADDR\\) at $ADDR
	219	REFCNT = 2
235cc2e3	220	FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
9248c45a	221	NV = 0
	222	PROTOTYPE = ""
	223	COMP_STASH = $ADDR\\t"main"
	224	START = $ADDR ===> \\d+
	225	ROOT = $ADDR
d04ba589	226	$XSUB
208edb77	227	GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
084d946d	228	FILE = ".*\\b(?i:peek\\.t)"
9248c45a	229	DEPTH = 0
9856a127	230	(?: MUTEXP = $ADDR
208edb77	231	OWNER = $ADDR
5b4563c8	232	)? FLAGS = 0x90
a3985cdc	233	OUTSIDE_SEQ = \\d+
9248c45a	234	PADLIST = $ADDR
dd2155a4	235	PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
9248c45a	236	OUTSIDE = $ADDR \\(MAIN\\)');
	237
	238	do_test(14,
	239	\&do_test,
	240	'SV = RV\\($ADDR\\) at $ADDR
	241	REFCNT = 1
	242	FLAGS = \\(ROK\\)
	243	RV = $ADDR
	244	SV = PVCV\\($ADDR\\) at $ADDR
9856a127	245	REFCNT = (3\|4)
9248c45a	246	FLAGS = \\(\\)
9248c45a	247	NV = 0
	248	COMP_STASH = $ADDR\\t"main"
	249	START = $ADDR ===> \\d+
	250	ROOT = $ADDR
d04ba589	251	$XSUB
9248c45a	252	GVGV::GV = $ADDR\\t"main" :: "do_test"
084d946d	253	FILE = ".*\\b(?i:peek\\.t)"
9248c45a	254	DEPTH = 1
9856a127	255	(?: MUTEXP = $ADDR
208edb77	256	OWNER = $ADDR
208edb77	257	)? FLAGS = 0x0
a3985cdc	258	OUTSIDE_SEQ = \\d+
9248c45a	259	PADLIST = $ADDR
dd2155a4	260	PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
ee6cee0c	261	\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern"
b5c19bd7	262	\\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0
ee6cee0c	263	\\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump"
9248c45a	264	OUTSIDE = $ADDR \\(MAIN\\)');
	265
	266	do_test(15,
	267	qr(tic),
	268	'SV = RV\\($ADDR\\) at $ADDR
	269	REFCNT = 1
	270	FLAGS = \\(ROK\\)
	271	RV = $ADDR
	272	SV = PVMG\\($ADDR\\) at $ADDR
	273	REFCNT = 1
faf82a0b	274	FLAGS = \\(OBJECT,SMG\\)
9248c45a	275	IV = 0
	276	NV = 0
	277	PV = 0
	278	MAGIC = $ADDR
	279	MG_VIRTUAL = $ADDR
14befaf4	280	MG_TYPE = PERL_MAGIC_qr\(r\)
9248c45a	281	MG_OBJ = $ADDR
	282	STASH = $ADDR\\t"Regexp"');
	283
	284	do_test(16,
	285	(bless {}, "Tac"),
	286	'SV = RV\\($ADDR\\) at $ADDR
	287	REFCNT = 1
	288	FLAGS = \\(ROK\\)
	289	RV = $ADDR
	290	SV = PVHV\\($ADDR\\) at $ADDR
	291	REFCNT = 2
	292	FLAGS = \\(OBJECT,SHAREKEYS\\)
9248c45a	293	STASH = $ADDR\\t"Tac"
	294	ARRAY = 0x0
	295	KEYS = 0
	296	FILL = 0
	297	MAX = 7
	298	RITER = -1
	299	EITER = 0x0');
	300
	301	do_test(17,
	302	*a,
	303	'SV = PVGV\\($ADDR\\) at $ADDR
	304	REFCNT = 5
b07ccbd7	305	FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
9248c45a	306	IV = 0
	307	NV = 0
	308	MAGIC = $ADDR
	309	MG_VIRTUAL = &PL_vtbl_glob
14befaf4	310	MG_TYPE = PERL_MAGIC_glob\(\*\)
9248c45a	311	MG_OBJ = $ADDR
9248c45a	312	NAME = "a"
	313	NAMELEN = 1
	314	GvSTASH = $ADDR\\t"main"
	315	GP = $ADDR
	316	SV = $ADDR
	317	REFCNT = 1
	318	IO = 0x0
	319	FORM = 0x0
	320	AV = 0x0
	321	HV = 0x0
	322	CV = 0x0
	323	CVGEN = 0x0
9ec58fb7	324	LINE = \\d+
084d946d	325	FILE = ".*\\b(?i:peek\\.t)"
e39917cc	326	FLAGS = $ADDR
9248c45a	327	EGV = $ADDR\\t"a"');
9248c45a	328
cdb2dd7b	329	if (ord('A') == 193) {
	330	do_test(18,
	331	chr(256).chr(0).chr(512),
	332	'SV = PV\\($ADDR\\) at $ADDR
	333	REFCNT = 1
235cc2e3	334	FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
cdb2dd7b	335	PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
cdb2dd7b	336	CUR = 5
1badabf5	337	LEN = \\d+');
cdb2dd7b	338	} else {
e6abe6d8	339	do_test(18,
	340	chr(256).chr(0).chr(512),
	341	'SV = PV\\($ADDR\\) at $ADDR
	342	REFCNT = 1
235cc2e3	343	FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
98c991d1	344	PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
e6abe6d8	345	CUR = 5
1badabf5	346	LEN = \\d+');
cdb2dd7b	347	}
e6abe6d8	348
cdb2dd7b	349	if (ord('A') == 193) {
	350	do_test(19,
	351	{chr(256)=>chr(512)},
	352	'SV = RV\\($ADDR\\) at $ADDR
	353	REFCNT = 1
	354	FLAGS = \\(ROK\\)
	355	RV = $ADDR
	356	SV = PVHV\\($ADDR\\) at $ADDR
	357	REFCNT = 2
b2caaddd	358	FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
cdb2dd7b	359	ARRAY = $ADDR \\(0:7, 1:1\\)
	360	hash quality = 100.0%
	361	KEYS = 1
	362	FILL = 1
	363	MAX = 7
	364	RITER = -1
	365	EITER = $ADDR
6cbfa5b4	366	Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
cdb2dd7b	367	SV = PV\\($ADDR\\) at $ADDR
	368	REFCNT = 1
	369	FLAGS = \\(POK,pPOK,UTF8\\)
	370	PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
	371	CUR = 2
1badabf5	372	LEN = \\d+');
cdb2dd7b	373	} else {
98c991d1	374	do_test(19,
	375	{chr(256)=>chr(512)},
	376	'SV = RV\\($ADDR\\) at $ADDR
	377	REFCNT = 1
	378	FLAGS = \\(ROK\\)
	379	RV = $ADDR
	380	SV = PVHV\\($ADDR\\) at $ADDR
	381	REFCNT = 2
19692e8d	382	FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
98c991d1	383	ARRAY = $ADDR \\(0:7, 1:1\\)
	384	hash quality = 100.0%
	385	KEYS = 1
	386	FILL = 1
	387	MAX = 7
	388	RITER = -1
	389	EITER = $ADDR
	390	Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
	391	SV = PV\\($ADDR\\) at $ADDR
	392	REFCNT = 1
	393	FLAGS = \\(POK,pPOK,UTF8\\)
	394	PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
	395	CUR = 2
1badabf5	396	LEN = \\d+');
cdb2dd7b	397	}
98c991d1	398
99331854	399	my $x="";
	400	$x=~/.??/g;
	401	do_test(20,
	402	$x,
	403	'SV = PVMG\\($ADDR\\) at $ADDR
	404	REFCNT = 1
235cc2e3	405	FLAGS = \\(PADMY,SMG,POK,pPOK\\)
99331854	406	IV = 0
	407	NV = 0
	408	PV = $ADDR ""\\\0
	409	CUR = 0
1936d2a7	410	LEN = \d+
99331854	411	MAGIC = $ADDR
	412	MG_VIRTUAL = &PL_vtbl_mglob
	413	MG_TYPE = PERL_MAGIC_regex_global\\(g\\)
	414	MG_FLAGS = 0x01
	415	MINMATCH');
	416
f24fdb76	417	#
	418	# TAINTEDDIR is not set on: OS2, AMIGAOS, WIN32, MSDOS
	419	# environment variables may be invisibly case-forced, hence the (?i:PATH)
5e836f43	420	# C<scalar(@ARGV)> is turned into an IV on VMS hence the (?:IV)?
d9baf692	421	# VMS is setting FAKE and READONLY flags. What VMS uses for storing
d9baf692	422	# ENV hashes is also not always null terminated.
f24fdb76	423	#
99331854	424	do_test(21,
	425	$ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
	426	'SV = PVMG\\($ADDR\\) at $ADDR
	427	REFCNT = 1
	428	FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
	429	IV = 0
	430	NV = 0
	431	PV = $ADDR "0"\\\0
	432	CUR = 1
	433	LEN = \d+
	434	MAGIC = $ADDR
	435	MG_VIRTUAL = &PL_vtbl_envelem
	436	MG_TYPE = PERL_MAGIC_envelem\\(e\\)
d25a523c	437	(?: MG_FLAGS = 0x01
99331854	438	TAINTEDDIR
143a3e5e	439	)? MG_LEN = -?\d+
143a3e5e	440	MG_PTR = $ADDR (?:"(?i:PATH)"\|=> HEf_SVKEY
5e836f43	441	SV = PV(?:IV)?\\($ADDR\\) at $ADDR
143a3e5e	442	REFCNT = \d+
11e2783c	443	FLAGS = \\(TEMP,POK,(?:FAKE,READONLY,)?pPOK\\)
f0fabfd7	444	(?: IV = 0
d9baf692	445	)? PV = $ADDR "(?i:PATH)"(?:\\\0)?
143a3e5e	446	CUR = \d+
143a3e5e	447	LEN = \d+)
99331854	448	MAGIC = $ADDR
	449	MG_VIRTUAL = &PL_vtbl_taint
	450	MG_TYPE = PERL_MAGIC_taint\\(t\\)');
	451
9248c45a	452	END {
92e5451f	453	1 while unlink("peek$$");
9248c45a	454	}
6bf47b08	455
	456	# blessed refs
	457	do_test(22,
	458	bless(\\undef, 'Foobar'),
	459	'SV = RV\\($ADDR\\) at $ADDR
	460	REFCNT = 1
	461	FLAGS = \\(ROK\\)
	462	RV = $ADDR
	463	SV = PVMG\\($ADDR\\) at $ADDR
	464	REFCNT = 2
	465	FLAGS = \\(OBJECT,ROK\\)
7957ad98	466	IV = -?\d+
7957ad98	467	NV = $FLOAT
6bf47b08	468	RV = $ADDR
	469	SV = NULL\\(0x0\\) at $ADDR
	470	REFCNT = \d+
	471	FLAGS = \\(READONLY\\)
	472	PV = $ADDR ""
	473	CUR = 0
	474	LEN = 0
	475	STASH = $ADDR\s+"Foobar"');
b1886099	476
	477	# Constant subroutines
	478
	479	sub const () {
	480	"Perl rules";
	481	}
	482
	483	do_test(23,
	484	\&const,
	485	'SV = RV\\($ADDR\\) at $ADDR
	486	REFCNT = 1
	487	FLAGS = \\(ROK\\)
	488	RV = $ADDR
	489	SV = PVCV\\($ADDR\\) at $ADDR
	490	REFCNT = (2)
	491	FLAGS = \\(POK,pPOK,CONST\\)
b1886099	492	NV = 0
	493	PROTOTYPE = ""
	494	COMP_STASH = 0x0
d04ba589	495	$ROOT
b1886099	496	XSUB = $ADDR
	497	XSUBANY = $ADDR \\(CONST SV\\)
	498	SV = PV\\($ADDR\\) at $ADDR
	499	REFCNT = 1
	500	FLAGS = \\(.*POK,READONLY,pPOK\\)
	501	PV = $ADDR "Perl rules"\\\0
	502	CUR = 10
	503	LEN = \\d+
	504	GVGV::GV = $ADDR\\t"main" :: "const"
	505	FILE = ".*\\b(?i:peek\\.t)"
	506	DEPTH = 0
	507	(?: MUTEXP = $ADDR
	508	OWNER = $ADDR
d04ba589	509	)? FLAGS = 0x1400
b1886099	510	OUTSIDE_SEQ = 0
	511	PADLIST = 0x0
	512	OUTSIDE = 0x0 \\(null\\)');