*/
/*
- * $Id: Storable.xs,v 1.0.1.7 2001/02/17 12:25:26 ram Exp $
+ * $Id: Storable.xs,v 1.0.1.8 2001/03/15 00:20:55 ram Exp $
*
* Copyright (c) 1995-2000, Raphael Manfredi
*
* in the README file that comes with the distribution.
*
* $Log: Storable.xs,v $
+ * Revision 1.0.1.8 2001/03/15 00:20:55 ram
+ * patch11: last version was wrongly compiling with assertions on
+ *
* Revision 1.0.1.7 2001/02/17 12:25:26 ram
* patch8: now bless objects ASAP at retrieve time
* patch8: added support for blessed ref to tied structures
* Revision 1.0.1.3 2000/09/29 19:49:57 ram
* patch3: avoid using "tainted" and "dirty" since Perl remaps them via cpp
*
- * $Log: Storable.xs,v $
+ * Revision 1.0.1.2 2000/09/28 21:43:10 ram
+ * patch2: perls before 5.004_04 lack newSVpvn
+ *
+ * Revision 1.0.1.1 2000/09/17 16:47:49 ram
+ * patch1: now only taint retrieved data when source was tainted
+ * patch1: added support for UTF-8 strings
+ * patch1: fixed store hook bug: was allocating class id too soon
+ *
* Revision 1.0 2000/09/01 19:40:41 ram
* Baseline for first official release.
*
#include <EXTERN.h>
#include <perl.h>
-#include <patchlevel.h> /* Perl's one, needed since 5.6 */
#include <XSUB.h>
#if 0
*/
#ifndef PERL_VERSION /* For perls < 5.6 */
+#include <patchlevel.h>
#define PERL_VERSION PATCHLEVEL
#ifndef newRV_noinc
#define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv)
#endif
#ifdef DEBUGME
+
+#ifndef DASSERT
+#define DASSERT
+#endif
+
/*
* TRACEME() will only output things when the $Storable::DEBUGME is true.
*/
} while (0)
#else
#define TRACEME(x)
-#endif
+#endif /* DEBUGME */
-#ifndef DASSERT
-#define DASSERT
-#endif
#ifdef DASSERT
#define ASSERT(x,y) do { \
if (!(x)) { \
HV *hclass; /* which classnames have been seen, store time */
AV *aclass; /* which classnames have been seen, retrieve time */
HV *hook; /* cache for hook methods per class name */
- I32 tagnum; /* incremented at store time for each seen object */
- I32 classnum; /* incremented at store time for each seen classname */
+ IV tagnum; /* incremented at store time for each seen object */
+ IV classnum; /* incremented at store time for each seen classname */
int netorder; /* true if network order used */
int s_tainted; /* true if input source is tainted, at retrieve time */
int forgive_me; /* whether to be forgiving... */
*/
hv_iterinit(cxt->hseen);
- while (he = hv_iternext(cxt->hseen))
+ while ((he = hv_iternext(cxt->hseen)))
HeVAL(he) = &PL_sv_undef;
hv_iterinit(cxt->hclass);
- while (he = hv_iternext(cxt->hclass))
+ while ((he = hv_iternext(cxt->hclass)))
HeVAL(he) = &PL_sv_undef;
/*
{
GV *gv;
SV *sv;
- SV **svh;
/*
* The following code is the same as the one performed by UNIVERSAL::can
continue;
}
TRACEME(("(#%d) item", i));
- if (ret = store(cxt, *sav))
+ if ((ret = store(cxt, *sav)))
return ret;
}
TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
- if (ret = store(cxt, val))
+ if ((ret = store(cxt, val)))
goto out;
/*
TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val)));
- if (ret = store(cxt, val))
+ if ((ret = store(cxt, val)))
goto out;
/*
* accesses on the retrieved object will indeed call the magic methods...
*/
- if (ret = store(cxt, mg->mg_obj))
+ if ((ret = store(cxt, mg->mg_obj)))
return ret;
TRACEME(("ok (tied)"));
PUTMARK(SX_TIED_KEY);
TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj)));
- if (ret = store(cxt, mg->mg_obj))
+ if ((ret = store(cxt, mg->mg_obj)))
return ret;
TRACEME(("store_tied_item: storing PTR 0x%"UVxf, PTR2UV(mg->mg_ptr)));
- if (ret = store(cxt, (SV *) mg->mg_ptr))
+ if ((ret = store(cxt, (SV *) mg->mg_ptr)))
return ret;
} else {
I32 idx = mg->mg_len;
PUTMARK(SX_TIED_IDX);
TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj)));
- if (ret = store(cxt, mg->mg_obj))
+ if ((ret = store(cxt, mg->mg_obj)))
return ret;
TRACEME(("store_tied_item: storing IDX %d", idx));
I32 classnum;
int ret;
int clone = cxt->optype & ST_CLONE;
- char mtype; /* for blessed ref to tied structures */
- unsigned char eflags; /* used when object type is SHT_EXTRA */
+ char mtype = 0; /* for blessed ref to tied structures */
+ unsigned char eflags = 0; /* used when object type is SHT_EXTRA */
TRACEME(("store_hook, class \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum));
* Serialize entry if not done already, and get its tag.
*/
- if (svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE))
+ if ((svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE)))
goto sv_seen; /* Avoid moving code too far to the right */
TRACEME(("listed object %d at 0x%"UVxf" is unknown", i-1, PTR2UV(xsv)));
} else
PUTMARK(flags);
- if (ret = store(cxt, xsv)) /* Given by hook for us to store */
+ if ((ret = store(cxt, xsv))) /* Given by hook for us to store */
return ret;
svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE);
* [<magic object>]
*/
- if (ret = store(cxt, mg->mg_obj))
+ if ((ret = store(cxt, mg->mg_obj)))
return ret;
}
* Store placeholder string as a scalar instead...
*/
- (void) sprintf(buf, "You lost %s(0x%"UVxf")\0", sv_reftype(sv, FALSE),
- PTR2UV(sv));
+ (void) sprintf(buf, "You lost %s(0x%"UVxf")%c", sv_reftype(sv, FALSE),
+ PTR2UV(sv), (char)0);
len = strlen(buf);
STORE_SCALAR(buf, len);
{
SV **svh;
int ret;
- SV *tag;
int type;
HV *hseen = cxt->hseen;
sva = av_fetch(cxt->aclass, idx, FALSE);
if (!sva)
- CROAK(("Class name #%d should have been seen already", (int)idx));
+ CROAK(("Class name #%"IVdf" should have been seen already",
+ (IV)idx));
class = SvPVX(*sva); /* We know it's a PV, by construction */
SV *sv;
SV *rv;
int obj_type;
- I32 classname;
int clone = cxt->optype & ST_CLONE;
char mtype = '\0';
unsigned int extra_type = 0;
sva = av_fetch(cxt->aclass, idx, FALSE);
if (!sva)
- CROAK(("Class name #%d should have been seen already", (int)idx));
+ CROAK(("Class name #%"IVdf" should have been seen already",
+ (IV)idx));
class = SvPVX(*sva); /* We know it's a PV, by construction */
TRACEME(("class ID %d => %s", idx, class));
tag = ntohl(tag);
svh = av_fetch(cxt->aseen, tag, FALSE);
if (!svh)
- CROAK(("Object #%d should have been retrieved already", (int)tag));
+ CROAK(("Object #%"IVdf" should have been retrieved already", (IV)tag));
xsv = *svh;
ary[i] = SvREFCNT_inc(xsv);
}
{
SV *sv;
int siv;
+ signed char tmp; /* must use temp var to work around
+ an AIX compiler bug --H.Merijn Brand */
TRACEME(("retrieve_byte (#%d)", cxt->tagnum));
GETMARK(siv);
TRACEME(("small integer read as %d", (unsigned char) siv));
- sv = newSViv((unsigned char) siv - 128);
+ tmp = ((unsigned char)siv) - 128;
+ sv = newSViv (tmp);
+
SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
- TRACEME(("byte %d", (unsigned char) siv - 128));
+ TRACEME(("byte %d", tmp));
TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv)));
return sv;
I32 i;
HV *hv;
SV *sv;
- static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
TRACEME(("retrieve_hash (#%d)", cxt->tagnum));
I32 size;
I32 i;
HV *hv;
- SV *sv;
+ SV *sv=NULL;
int c;
static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */
* information to check.
*/
- if (cxt->netorder = (use_network_order & 0x1))
+ if ((cxt->netorder = (use_network_order & 0x1)))
return &PL_sv_undef; /* No byte ordering info */
sprintf(byteorder, "%lx", (unsigned long) BYTEORDER);
I32 tagn;
svh = hv_fetch(cxt->hseen, (char *) &tag, sizeof(tag), FALSE);
if (!svh)
- CROAK(("Old tag 0x%x should have been mapped already", (unsigned)tag));
+ CROAK(("Old tag 0x%"UVxf" should have been mapped already", (UV)tag));
tagn = SvIV(*svh); /* Mapped tag number computed earlier below */
/*
svh = av_fetch(cxt->aseen, tagn, FALSE);
if (!svh)
- CROAK(("Object #%d should have been retrieved already", (int)tagn));
+ CROAK(("Object #%"IVdf" should have been retrieved already", (IV)tagn));
sv = *svh;
TRACEME(("has retrieved #%d at 0x%"UVxf, tagn, PTR2UV(sv)));
SvREFCNT_inc(sv); /* One more reference to this same sv */
tag = ntohl(tag);
svh = av_fetch(cxt->aseen, tag, FALSE);
if (!svh)
- CROAK(("Object #%d should have been retrieved already", (int)tag));
+ CROAK(("Object #%"IVdf" should have been retrieved already",
+ (IV)tag));
sv = *svh;
TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv)));
SvREFCNT_inc(sv); /* One more reference to this same sv */
projects / p5sagit/p5-mst-13.2.git / blobdiff