greg/stasis-aries-wal
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

fixed warnings, turn on -Werror for Inline::Perl, added (untested) array methods to perl bindings

Browse source
This commit is contained in:
Sears Russell 2009-12-14 18:07:57 +00:00
parent 230d863ff7
commit 5e2c02149c
2 changed files with 33 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
lang/perl/Stasis.pm
View file

@ -10,9 +10,11 @@ BEGIN {
} }
1; 1;
} }
use Inline C => Config => LIBS => use Inline C => Config => (LIBS =>
"-L$STASIS_DIR/build/src/stasis/ " . "-L$STASIS_DIR/build/src/stasis/ " .
"-lstasis ", "-lstasis ",
CCFLAGS => "-Wall -pedantic -Werror -std=c99 -DPERL_GCC_PEDANTIC"
),
ENABLE => AUTOWRAP, ENABLE => AUTOWRAP,
TYPEMAPS => "$STASIS_DIR/lang/perl/typemap", TYPEMAPS => "$STASIS_DIR/lang/perl/typemap",
PREFIX => 'stasis_perl_'; PREFIX => 'stasis_perl_';
@ -96,8 +98,6 @@ __DATA__
__C__ __C__
#include "stasis/transactional.h" #include "stasis/transactional.h"
static int initted;
int Tinit(); int Tinit();
int Tdeinit(); int Tdeinit();
int Tbegin(); int Tbegin();
@ -151,14 +151,14 @@ static byte * bytes_SV(SV* sv, STRLEN * sz) {
byte * ret = 0; byte * ret = 0;
IV valI; IV valI;
NV valN; NV valN;
char* valP; byte* valP;
byte * tmp; byte * tmp;
recordid valR; recordid valR;
char code; char code;
if(SvIOK(sv)) { if(SvIOK(sv)) {
// signed int, machine length // signed int, machine length
valI = SvIV(sv); valI = SvIV(sv);
*sz = sizeof(IV); *sz = (STRLEN)sizeof(IV);
tmp = (byte*)&valI; tmp = (byte*)&valI;
code = 'I'; code = 'I';
} else if (SvNOK(sv)) { } else if (SvNOK(sv)) {
@ -207,7 +207,7 @@ static SV * SV_bytes(byte* bytes, STRLEN sz) {
ret = newSVnv(*(NV*)bytes); ret = newSVnv(*(NV*)bytes);
} break; } break;
case 'P': { case 'P': {
ret = newSVpvn(bytes,sz-2); ret = newSVpvn((const char*)bytes,sz-2);
} break; } break;
case 'R': { case 'R': {
assert(sz-1 == sizeof(recordid)); assert(sz-1 == sizeof(recordid));
@ -220,6 +220,8 @@ static SV * SV_bytes(byte* bytes, STRLEN sz) {
return ret; return ret;
} }
/** Records */
recordid TallocScalar(int xid, SV* sv) { recordid TallocScalar(int xid, SV* sv) {
STRLEN sz; STRLEN sz;
byte * buf = bytes_SV(sv, &sz); byte * buf = bytes_SV(sv, &sz);
@ -237,7 +239,7 @@ int stasis_perl_Tset(int xid, recordid rid, SV * sv) {
} }
SV* stasis_perl_Tread(int xid, recordid rid) { SV* stasis_perl_Tread(int xid, recordid rid) {
rid.size = TrecordSize(xid, rid); rid.size = TrecordSize(xid, rid);
char * buf = malloc(rid.size); byte * buf = malloc(rid.size);
Tread(xid, rid, buf); Tread(xid, rid, buf);
SV* ret = SV_bytes(buf, rid.size); SV* ret = SV_bytes(buf, rid.size);
free(buf); free(buf);
@ -255,6 +257,8 @@ recordid stasis_perl_TreadRecordid(int xid, recordid rid) {
return buf; return buf;
} }
/** Hash table */
recordid stasis_perl_ThashCreate(int xid) { recordid stasis_perl_ThashCreate(int xid) {
return ThashCreate(xid, VARIABLE_LENGTH, VARIABLE_LENGTH); return ThashCreate(xid, VARIABLE_LENGTH, VARIABLE_LENGTH);
} }
@ -297,6 +301,25 @@ void * stasis_perl_ThashIterator(int xid, recordid hash) {
return ThashGenericIterator(xid, hash); return ThashGenericIterator(xid, hash);
} }
/** Arrays */
recordid stasis_perl_TarrayList_alloc(int xid, SV* exemplar) {
byte * bytes;
size_t sz;
bytes = bytes_SV(exemplar, &sz);
return TarrayListAlloc(xid, 4, 2, sz);
free(bytes);
}
int stasis_perl_TarrayList_extend(int xid, recordid rid, int slots) {
return TarrayListExtend(xid, rid, slots);
}
int stasis_perl_TarrayList_length(int xid, recordid rid) {
return TarrayListLength(xid, rid);
}
/** Iterators */
int stasis_perl_Titerator_next(int xid, void *it) { int stasis_perl_Titerator_next(int xid, void *it) {
return Titerator_next(xid, it); return Titerator_next(xid, it);
} }
@ -327,31 +350,3 @@ SV* stasis_perl_NULL_RID() {
int stasis_perl_INVALID_SLOT() { int stasis_perl_INVALID_SLOT() {
return INVALID_SLOT; return INVALID_SLOT;
} }
/*SV* new() {
void * session = 0;
Tinit();
SV* obj_ref = newSViv(0);
SV* obj = newSVrv(obj_ref, "Stasis");
sv_setiv(obj, (IV)session);
SvREADONLY_on(obj);
return obj_ref;
}
int begin_xact(SV* obj) {
return Tbegin();
}
void commit_xact(SV* obj, int xid) {
Tcommit(xid);
}
void abort_xact(SV* obj, int xid) {
Tabort(xid);
}
void DESTROY(SV* obj) {
Tdeinit();
}
*/

2
lang/perl/t/test3.pl
View file

@ -49,7 +49,7 @@ Stasis::Tabort($xid);
$xid = Stasis::Tbegin(); $xid = Stasis::Tbegin();
tie %h, 'Stasis::Hash', $xid, $rid; tie %h, 'Stasis::Hash', $xid, $rid;
my $i = 0; $i = 0;
foreach my $x (qw(k l m n o p q r s t)) { foreach my $x (qw(k l m n o p q r s t)) {
$i++; $i++;
$h{$x}=$i; $h{$x}=$i;