cvs commit: ponie/src/pmc perl5cargo_cult.pmc
[email protected] (Nicholas Clark) 29 Apr 2005 21:11:39 -0000
| Newsgroups | perl.ponie.changes |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/04/29 14:11:39
Modified: perl dump.c sv.h
perl/ext/Devel/Peek/t Peek.t
src/pmc perl5cargo_cult.pmc
Log:
Display the PMC name from the vtable as part of the Perl 5 dump output - very
useful when the PMC has got confused and the vtable and flags disagree
Revision Changes Path
1.7 +5 -2 ponie/perl/dump.c
Index: dump.c
===================================================================
RCS file: /cvs/public/ponie/perl/dump.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- dump.c 19 Apr 2005 19:04:13 -0000 1.6
+++ dump.c 29 Apr 2005 21:11:39 -0000 1.7
@@ -1096,6 +1096,8 @@
const char *s;
U32 flags;
U32 type;
+ char *pmc_name = Parrot_PMC_get_cstring_intkey(PL_Parrot, MUMBLE(sv),
+ Ponie_S_WHOAMI);
if (!sv) {
Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
@@ -1106,10 +1108,11 @@
type = SvTYPE(sv);
d = Perl_newSVpvf(aTHX_
- "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
- PTR2UV(SvANY(sv)), PTR2UV(sv),
+ "(0x%"UVxf") at 0x%"UVxf" [%s]\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (",
+ PTR2UV(SvANY(sv)), PTR2UV(sv), pmc_name,
(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
(int)(PL_dumpindent*level), "");
+ Parrot_free_cstring(pmc_name);
if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
1.69 +6 -0 ponie/perl/sv.h
Index: sv.h
===================================================================
RCS file: /cvs/public/ponie/perl/sv.h,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -r1.68 -r1.69
--- sv.h 27 Apr 2005 13:18:30 -0000 1.68
+++ sv.h 29 Apr 2005 21:11:39 -0000 1.69
@@ -325,6 +325,12 @@
Ponie_I_MAX
} Ponie_integers;
+/* All the things get_pointer_keyed_int can return. */
+
+typedef enum {
+ Ponie_S_WHOAMI, /* whoami string from the vtable */
+ Ponie_S_MAX
+} Ponie_strings;
#define SVTYPEMASK 0xff
#define SvTYPE(sv) ((U32)Parrot_PMC_get_intval_intkey(PL_Parrot,MUMBLE(sv), Ponie_I_SV_TYPE))
1.14 +41 -41 ponie/perl/ext/Devel/Peek/t/Peek.t
Index: Peek.t
===================================================================
RCS file: /cvs/public/ponie/perl/ext/Devel/Peek/t/Peek.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- Peek.t 4 Apr 2005 17:46:15 -0000 1.13
+++ Peek.t 29 Apr 2005 21:11:39 -0000 1.14
@@ -53,7 +53,7 @@
do_test( 1,
$a = "foo",
-'SV = PV\\($ADDR\\) at $ADDR
+'SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(POK,pPOK\\)
PV = $ADDR "foo"\\\0
@@ -63,7 +63,7 @@
do_test( 2,
"bar",
-'SV = PV\\($ADDR\\) at $ADDR
+'SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(.*POK,READONLY,pPOK\\)
PV = $ADDR "bar"\\\0
@@ -72,21 +72,21 @@
do_test( 3,
$b = 123,
-'SV = IV\\($ADDR\\) at $ADDR
+'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(IOK,pIOK\\)
IV = 123');
do_test( 4,
456,
-'SV = IV\\($ADDR\\) at $ADDR
+'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(.*IOK,READONLY,pIOK\\)
IV = 456');
do_test( 5,
$c = 456,
-'SV = IV\\($ADDR\\) at $ADDR
+'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(PADMY,IOK,pIOK\\)
IV = 456');
@@ -98,7 +98,7 @@
# building subsequent regexps.
my $type = do_test( 6,
$c + $d,
-'SV = ([NI])V\\($ADDR\\) at $ADDR
+'SV = ([NI])V\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(PADTMP,\1OK,p\1OK\\)
\1V = 456');
@@ -107,7 +107,7 @@
do_test( 7,
$d,
-'SV = PVNV\\($ADDR\\) at $ADDR
+'SV = PVNV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(NOK,pNOK\\)
IV = 0
@@ -118,24 +118,24 @@
do_test( 8,
0xabcd,
-'SV = IV\\($ADDR\\) at $ADDR
+'SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(.*IOK,READONLY,pIOK\\)
IV = 43981');
do_test( 9,
undef,
-'SV = NULL\\(0x0\\) at $ADDR
+'SV = NULL\\(0x0\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(\\)');
do_test(10,
\$a,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PV\\($ADDR\\) at $ADDR
+ SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(POK,pPOK\\)
PV = $ADDR "foo"\\\0
@@ -145,7 +145,7 @@
my $c_pattern;
if ($type eq 'N') {
$c_pattern = '
- SV = PVNV\\($ADDR\\) at $ADDR
+ SV = PVNV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
IV = 456
@@ -153,18 +153,18 @@
PV = 0';
} else {
$c_pattern = '
- SV = IV\\($ADDR\\) at $ADDR
+ SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(IOK,pIOK\\)
IV = 456';
}
do_test(11,
[$b,$c],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVAV\\($ADDR\\) at $ADDR
+ SV = PVAV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(\\)
IV = 0
@@ -175,7 +175,7 @@
ARYLEN = 0x0
FLAGS = \\(REAL\\)
Elt No. 0
- SV = IV\\($ADDR\\) at $ADDR
+ SV = IV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(IOK,pIOK\\)
IV = 123
@@ -183,11 +183,11 @@
do_test(12,
{$b=>$c},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVHV\\($ADDR\\) at $ADDR
+ SV = PVHV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(SHAREKEYS\\)
IV = 1
@@ -203,11 +203,11 @@
do_test(13,
sub(){@_},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVCV\\($ADDR\\) at $ADDR
+ SV = PVCV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(PADMY,POK,pPOK,ANON,WEAKOUTSIDE\\)
IV = 0
@@ -231,11 +231,11 @@
do_test(14,
\&do_test,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVCV\\($ADDR\\) at $ADDR
+ SV = PVCV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = (3|4)
FLAGS = \\(\\)
IV = 0
@@ -261,11 +261,11 @@
do_test(15,
qr(tic),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVMG\\($ADDR\\) at $ADDR
+ SV = PVMG\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(OBJECT,SMG\\)
IV = 0
@@ -279,11 +279,11 @@
do_test(16,
(bless {}, "Tac"),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVHV\\($ADDR\\) at $ADDR
+ SV = PVHV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(OBJECT,SHAREKEYS\\)
IV = 0
@@ -298,7 +298,7 @@
do_test(17,
*a,
-'SV = PVGV\\($ADDR\\) at $ADDR
+'SV = PVGV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 5
FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
IV = 0
@@ -328,7 +328,7 @@
if (ord('A') == 193) {
do_test(18,
chr(256).chr(0).chr(512),
-'SV = PV\\($ADDR\\) at $ADDR
+'SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
PV = $ADDR "\\\214\\\101\\\0\\\235\\\101"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
@@ -337,7 +337,7 @@
} else {
do_test(18,
chr(256).chr(0).chr(512),
-'SV = PV\\($ADDR\\) at $ADDR
+'SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\((?:PADTMP,)?POK,READONLY,pPOK,UTF8\\)
PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 \[UTF8 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"\]
@@ -348,11 +348,11 @@
if (ord('A') == 193) {
do_test(19,
{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVHV\\($ADDR\\) at $ADDR
+ SV = PVHV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
UV = 1
@@ -365,7 +365,7 @@
RITER = -1
EITER = $ADDR
Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
- SV = PV\\($ADDR\\) at $ADDR
+ SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(POK,pPOK,UTF8\\)
PV = $ADDR "\\\235\\\101"\\\0 \[UTF8 "\\\x\{200\}"\]
@@ -374,11 +374,11 @@
} else {
do_test(19,
{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVHV\\($ADDR\\) at $ADDR
+ SV = PVHV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
UV = 1
@@ -391,7 +391,7 @@
RITER = -1
EITER = $ADDR
Elt "\\\304\\\200" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
- SV = PV\\($ADDR\\) at $ADDR
+ SV = PV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(POK,pPOK,UTF8\\)
PV = $ADDR "\\\310\\\200"\\\0 \[UTF8 "\\\x\{200\}"\]
@@ -403,7 +403,7 @@
$x=~/.??/g;
do_test(20,
$x,
-'SV = PVMG\\($ADDR\\) at $ADDR
+'SV = PVMG\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(PADMY,SMG,POK,pPOK\\)
IV = 0
@@ -424,7 +424,7 @@
#
do_test(21,
$ENV{PATH}=@ARGV, # scalar(@ARGV) is a handy known tainted value
-'SV = PVMG\\($ADDR\\) at $ADDR
+'SV = PVMG\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(GMG,SMG,RMG,pIOK,pPOK\\)
IV = 0
@@ -439,7 +439,7 @@
TAINTEDDIR
)? MG_LEN = -?\d+
MG_PTR = $ADDR (?:"(?i:PATH)"|=> HEf_SVKEY
- SV = PV(?:IV)?\\($ADDR\\) at $ADDR
+ SV = PV(?:IV)?\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = \d+
FLAGS = \\(TEMP,POK,pPOK\\)
(?: IV = 0
@@ -457,17 +457,17 @@
# blessed refs
do_test(22,
bless(\\undef, 'Foobar'),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = RV\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 1
FLAGS = \\(ROK\\)
RV = $ADDR
- SV = PVMG\\($ADDR\\) at $ADDR
+ SV = PVMG\\($ADDR\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = 2
FLAGS = \\(OBJECT,ROK\\)
IV = -?\d+
NV = $FLOAT
RV = $ADDR
- SV = NULL\\(0x0\\) at $ADDR
+ SV = NULL\\(0x0\\) at $ADDR \\[Perl5[A-Z]+\\]
REFCNT = \d+
FLAGS = \\(READONLY\\)
CUR = 0
1.49 +13 -1 ponie/src/pmc/perl5cargo_cult.pmc
Index: perl5cargo_cult.pmc
===================================================================
RCS file: /cvs/public/ponie/src/pmc/perl5cargo_cult.pmc,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- perl5cargo_cult.pmc 28 Apr 2005 10:19:08 -0000 1.48
+++ perl5cargo_cult.pmc 29 Apr 2005 21:11:39 -0000 1.49
@@ -1578,6 +1578,18 @@
" in set_integer_keyed_int", key, Ponie_I_MAX - 1, value);
return;
}
+
+
+ Parrot_STRING get_string_keyed_int(INTVAL key) {
+ switch (key) {
+ case Ponie_S_WHOAMI:
+ return SELF->vtable->whoami;
+ default:
+ croak ("Out of range or illegal key %d (max is %d)"
+ " get_string_keyed_int", key, Ponie_S_MAX - 1);
+ }
+ return 0;
+ }
}
/*