File Coverage

line	stmt	bran	sub	pod	time	code
1						package Devel::Pointer::PP;
2	2		2		81590	use strict;
	2				6
	2				81
3	2		2		29	use 5.8.1;
	2				8
	2				90
4	2		2		21	use warnings;
	2				4
	2				74
5	2		2		10	use B;
	2				4
	2				117
6	2		2		10	use Exporter;
	2				10
	2				124
7	2		2		12	use vars qw(@ISA @SVCLASSNAMES @EXPORT %EXPORT_TAGS $VERSION);
	2				4
	2				462
8
9						BEGIN {
10	2		2		5	$VERSION = 1.01;
11	2				38	@ISA = 'Exporter';
12	2				8	@EXPORT = qw(address_of
13						deref
14						unsmash_sv
15						unsmash_av
16						unsmash_hv
17						unsmash_cv);
18	2				7	%EXPORT_TAGS = ( ':all', \ @EXPORT );
19
20	2				233	@SVCLASSNAMES =
21						map "B::$_",
22						qw( NULL
23						IV
24						NV
25						RV
26						PV
27						PVIV
28						PVNV
29						PVMG
30						BM
31						PVLV
32						AV
33						HV
34						CV
35						GV
36						FM
37						IO );
38						}
39
40	3		3	0	926	sub address_of { 0 + \ $_[0] }
41
42						BEGIN {
43	2		2		7	for my $name ('unsmash_sv',
44						'unsmash_av',
45						'unsmash_hv',
46						'unsmash_cv',
47						'deref') {
48	10	100	6	0	1714	eval "
	6	0	0	0	1070
	6	0	0	0	28
	4	0	0	0	11
	2	0	0	0	4
	6				18
	6				20
	6				16
	6				45
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
49						sub $name {
50						my \$address;
51						if ( \$_[0] =~ /0x([a-f\\d]+)/ ) {
52						\$address = hex \$1;
53						}
54						else {
55						\$address = 0 + \$_[0];
56						}
57
58						# Temporarilly bless the object as a generic SV so I can query for
59						# the type of the object.
60						my \$obj = bless \\\$address, 'B::SV';
61						my \$type = \$obj->SvTYPE;
62
63						bless \$obj, \$SVCLASSNAMES[ \$type ];
64
65						return \$obj->object_2svref;
66						}
67						";
68						}
69						}
70
71						1;
72						__END__