Front page | perl.perl5.porters |
Postings from August 2003
[PATCH] Re: Storable Error
Thread Previous
|
Thread Next
From:
Nicholas Clark
Date:
August 8, 2003 16:35
Subject:
[PATCH] Re: Storable Error
Message ID:
20030809003535.C20130@plum.flirble.org
Not a solution yet, but
On Thu, Aug 07, 2003 at 03:08:35AM +0530, Abhijit Menon-Sen wrote:
> At 2003-07-23 16:01:19 -0400, vbono@vinny.org wrote:
> >
> > Assertion flags == 0 failed: file "Storable.xs", line 2336
>
> The appended patch (relative to Storable 2.07) appears to paper over the
> problem. I have no convenient way to investigate this further, so could
> someone please:
I find that I can create hashes where key flags are set but HASKFLAGS is not
with the appended patch, and running t/op/utfhash.t with -DA
I'm not sure if this patch is a good idea. It adds 2 new debug flags
-DA calls sanity checking assert routines
-Dq suppresses the "EXECUTING..." line, without which regression tests fail.
and a new routine
Perl_hv_assert, which checks the consistency of hashes
I didn't make the compilation of Perl_hv_assert conditional on -DDEBUGGING
because it may be useful to call it from a debugger session, in a similar
fashion to Perl_sv_dump.
I've run out of time today to find the true bug, but at least I can
create an "impossible" hash
Hash has HASKFLAGS off but I count 1 key(s) with flags
SV = PVHV(0x81a6dd8) at 0x81e7774
REFCNT = 1
FLAGS = (PADBUSY,PADMY,SHAREKEYS)
IV = 1
NV = 0
ARRAY = 0x8261c38 (0:7, 1:1)
hash quality = 100.0%
KEYS = 1
FILL = 1
MAX = 7
RITER = -1
EITER = 0x0
Running the regression tests with export PERL5OPT=-DAq
and this patch causes 2 failures:
t/op/local...........................Can't locate object method "FIRSTKEY" via package "TH" at op/local.t line 140.
FAILED at test 42
t/op/split...........................# Failed at op/split.t line 58
FAILED at test 11
I don't understand why, as I pinched the iterator save/restore code
straight out of Storable. If it's not working, it suggests (another)
subtle Storable bug.
Nicholas Clark
--- ./pod/perlrun.pod.orig 2003-07-27 22:51:12.000000000 +0100
+++ ./pod/perlrun.pod 2003-08-08 21:57:13.000000000 +0100
@@ -382,6 +382,8 @@ B<-D14> is equivalent to B<-Dtls>):
524288 J Do not s,t,P-debug (Jump over) opcodes within package DB
1048576 v Verbose: use in conjunction with other flags
2097152 C Copy On Write
+ 4194304 A Consistency checks on internal structures
+ 8388608 q quiet - currently only suppressed the "EXECUTING" message
All these flags require B<-DDEBUGGING> when you compile the Perl
executable (but see L<Devel::Peek>, L<re> which may change this).
--- ./hv.c.orig 2003-07-27 22:25:45.000000000 +0100
+++ ./hv.c 2003-08-08 23:39:51.000000000 +0100
@@ -1691,6 +1691,8 @@ Perl_hv_clear(pTHX_ HV *hv)
if (!hv)
return;
+ DEBUG_A(Perl_hv_assert(aTHX_ hv));
+
xhv = (XPVHV*)SvANY(hv);
if (SvREADONLY(hv)) {
@@ -1783,6 +1785,7 @@ Perl_hv_undef(pTHX_ HV *hv)
register XPVHV* xhv;
if (!hv)
return;
+ DEBUG_A(Perl_hv_assert(aTHX_ hv));
xhv = (XPVHV*)SvANY(hv);
hfreeentries(hv);
Safefree(xhv->xhv_array /* HvARRAY(hv) */);
@@ -2285,3 +2288,73 @@ S_share_hek_flags(pTHX_ const char *str,
return HeKEY_hek(entry);
}
+
+
+/*
+=for apidoc hv_assert
+
+Check that a hash is in an internally consistent state.
+
+=cut
+*/
+
+void
+Perl_hv_assert(pTHX_ HV *hv)
+{
+ HE* entry;
+ int withflags = 0;
+ int placeholders = 0;
+ int real = 0;
+ int bad = 0;
+ I32 riter = HvRITER(hv);
+ HE *eiter = HvEITER(hv);
+
+ (void)hv_iterinit(hv);
+
+ while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
+ /* sanity check the values */
+ if (HeVAL(entry) == &PL_sv_placeholder) {
+ placeholders++;
+ } else {
+ real++;
+ }
+ /* sanity check the keys */
+ if (HeSVKEY(entry)) {
+ /* Don't know what to check on SV keys. */
+ } else if (HeKUTF8(entry)) {
+ withflags++;
+ if (HeKWASUTF8(entry)) {
+ PerlIO_printf(Perl_debug_log,
+ "hash key has both WASUFT8 and UTF8: '%.*s'\n",
+ (int) HeKLEN(entry), HeKEY(entry));
+ bad = 1;
+ }
+ } else if (HeKWASUTF8(entry)) {
+ withflags++;
+ }
+ }
+ if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+ if (HvUSEDKEYS(hv) != real) {
+ PerlIO_printf(Perl_debug_log, "Count %d key(s), but hash reports %d\n",
+ (int) real, (int) HvUSEDKEYS(hv));
+ bad = 1;
+ }
+ if (HvPLACEHOLDERS(hv) != placeholders) {
+ PerlIO_printf(Perl_debug_log,
+ "Count %d placeholder(s), but hash reports %d\n",
+ (int) placeholders, (int) HvPLACEHOLDERS(hv));
+ bad = 1;
+ }
+ }
+ if (withflags && ! HvHASKFLAGS(hv)) {
+ PerlIO_printf(Perl_debug_log,
+ "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
+ withflags);
+ bad = 1;
+ }
+ if (bad) {
+ sv_dump((SV *)hv);
+ }
+ HvRITER(hv) = riter; /* Restore hash iterator state */
+ HvEITER(hv) = eiter;
+}
--- ./perl.h.orig 2003-08-05 14:57:16.000000000 +0100
+++ ./perl.h 2003-08-08 21:58:19.000000000 +0100
@@ -2547,7 +2547,10 @@ Gid_t getegid (void);
#define DEBUG_R_FLAG 0x00040000 /* 262144 */
#define DEBUG_J_FLAG 0x00080000 /* 524288 */
#define DEBUG_v_FLAG 0x00100000 /*1048576 */
-#define DEBUG_MASK 0x001FEFFF /* mask of all the standard flags */
+/* 5.9.0 has C at 0x0020000 */
+#define DEBUG_A_FLAG 0x00400000 /*4194304 */
+#define DEBUG_q_FLAG 0x00800000 /8388608*/
+#define DEBUG_MASK 0x00DFEFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
@@ -2573,6 +2576,8 @@ Gid_t getegid (void);
# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
# define DEBUG_v_TEST_ (PL_debug & DEBUG_v_FLAG)
+# define DEBUG_A_TEST_ (PL_debug & DEBUG_A_FLAG)
+# define DEBUG_q_TEST_ (PL_debug & DEBUG_q_FLAG)
# define DEBUG_Xv_TEST_ (DEBUG_X_TEST_ && DEBUG_v_TEST_)
@@ -2602,6 +2607,8 @@ Gid_t getegid (void);
# define DEBUG_R_TEST DEBUG_R_TEST_
# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEBUG_v_TEST DEBUG_v_TEST_
+# define DEBUG_A_TEST DEBUG_A_TEST_
+# define DEBUG_q_TEST DEBUG_A_TEST_
# define PERL_DEB(a) a
# define PERL_DEBUG(a) if (PL_debug) a
@@ -2643,6 +2650,8 @@ Gid_t getegid (void);
# define DEBUG_T(a) DEBUG__(DEBUG_T_TEST, a)
# define DEBUG_R(a) DEBUG__(DEBUG_R_TEST, a)
# define DEBUG_v(a) DEBUG__(DEBUG_v_TEST, a)
+# define DEBUG_A(a) DEBUG__(DEBUG_A_TEST, a)
+# define DEBUG_q(a) DEBUG__(DEBUG_q_TEST, a)
#else /* DEBUGGING */
@@ -2667,6 +2676,8 @@ Gid_t getegid (void);
# define DEBUG_R_TEST (0)
# define DEBUG_J_TEST (0)
# define DEBUG_v_TEST (0)
+# define DEBUG_A_TEST (0)
+# define DEBUG_q_TEST (0)
# define PERL_DEB(a)
# define PERL_DEBUG(a)
@@ -2690,6 +2701,8 @@ Gid_t getegid (void);
# define DEBUG_T(a)
# define DEBUG_R(a)
# define DEBUG_v(a)
+# define DEBUG_A(a)
+# define DEBUG_q(a)
#endif /* DEBUGGING */
--- ./embed.fnc.orig 2003-07-23 15:29:18.000000000 +0100
+++ ./embed.fnc 2003-08-08 20:55:17.000000000 +0100
@@ -1407,8 +1407,8 @@ p |void |free_tied_hv_pool
#if defined(DEBUGGING)
p |int |get_debug_opts |char **s
#endif
+Apod |void |hv_assert |HV* tb
END_EXTERN_C
-
--- ./perl.c.orig 2003-08-05 14:57:16.000000000 +0100
+++ ./perl.c 2003-08-08 21:59:40.000000000 +0100
@@ -1794,7 +1794,8 @@ S_run_body(pTHX_ I32 oldscope)
if (!PL_restartop) {
DEBUG_x(dump_all());
- PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+ if (!DEBUG_q_TEST)
+ PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
PTR2UV(thr)));
@@ -2416,7 +2417,7 @@ Perl_get_debug_opts(pTHX_ char **s)
int i = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxu HXDSTRJvC";
+ static char debopts[] = "psltocPmfrxu HXDSTRJvCAq";
for (; isALNUM(**s); (*s)++) {
char *d = strchr(debopts,**s);
Thread Previous
|
Thread Next