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

clean up perl unit tests; add support for storing tied hashes in tied hashes

Browse source
This commit is contained in:
Sears Russell 2010-01-11 19:29:52 +00:00
parent 44e5e8b4fc
commit f041f0a653
6 changed files with 70 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lang/perl/CMakeLists.txt
View file

@ -1,5 +1,3 @@
#CREATE_CHECK_OPT(STASIS_DIR=${CMAKE_TOPLEVEL_SOURCE_DIR} ./t/test.pl)
#CREATE_CHECK_OPT(STASIS_DIR=${CMAKE_TOPLEVEL_SOURCE_DIR} ./t/test2.pl < t/test2.script)
SET(ENV{STASIS_DIR} ${CMAKE_HOME_DIRECTORY})
MACRO(CREATE_CHECK_PERL NAME)
ADD_TEST(${NAME} perl -I ${CMAKE_HOME_DIRECTORY}/lang/perl ${CMAKE_CURRENT_SOURCE_DIR}/${NAME} --automated-test)
@ -9,9 +7,7 @@ MACRO(CREATE_CHECK_PERL_OPT NAME OPT)
ADD_TEST(${NAME} perl -I ${CMAKE_HOME_DIRECTORY}/lang/perl ${CMAKE_CURRENT_SOURCE_DIR}/${NAME} --automated-test ${OPT})
ENDMACRO(CREATE_CHECK_PERL_OPT)
CREATE_CHECK_PERL(t/test.pl)
CREATE_CHECK_PERL_OPT(t/test2.pl ${CMAKE_CURRENT_SOURCE_DIR}/t/test2.script)
CREATE_CHECK_PERL(t/test3.pl)
#ADD_TEST(perl/test.pl perl -I${CMAKE_HOME_DIRECTORY}/lang/perl ${CMAKE_CURRENT_SOURCE_DIR}/t/test.pl)
#ADD_TEST(perl/t/test2.pl ${CMAKE_CURRENT_SOURCE_DIR}/t/test.pl STASIS_DIR=${CMAKE_HOME_DIRECTORY})
CREATE_CHECK_PERL(t/01-boostrap.t)
CREATE_CHECK_PERL_OPT(t/02-hash.t ${CMAKE_CURRENT_SOURCE_DIR}/t/02-hash.script)
CREATE_CHECK_PERL(t/03-hash-iterator.t)
CREATE_CHECK_PERL(t/04-hash-in-hash.t)

76
lang/perl/Stasis.pm
View file

@ -26,7 +26,14 @@ sub version {
return "Stasis 0.1";
}
sub ThashCreate {
my $xid = shift;
my $rid = ThashCreateHelper($xid);
return bless $rid, 'Stasis::HashHeader';
}
package Stasis::Hash;
require Scalar::Util;
require Tie::Hash;
@ -43,23 +50,59 @@ sub TIEHASH {
xid => $xid,
rid => $rid,
};
return bless $this, $class;
}
sub FETCH {
my $this = shift;
my $key = shift;
return Stasis::ThashLookup($$this{xid}, $$this{rid}, $key);
my $sv = Stasis::ThashLookup($$this{xid}, $$this{rid}, $key);
if(Scalar::Util::blessed($sv)) {
if($sv->isa('Stasis::HashHeader')) {
my %h;
tie(%h, 'Stasis::Hash', $$this{xid}, $sv);
return \%h;
} else {
die 'ThashLookup returned an object of unknown type';
}
} else {
return $sv;
}
}
sub STORE {
my $this = shift;
my $key = shift;
my $val = shift;
if('HASH' eq ref($val)) {
if(Scalar::Util::blessed($val) && $sv->isa('Stasis::Hash')) {
my $obj = tied ($val); # tied returns the object backing the hash.
Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $obj{rid});
} else {
# Copy the hash into scratch space
my %h;
foreach my $k (keys %$val) {
$h{$k} = $val{$k};
}
# Tie the hash that was passed to us
my $rid = Stasis::ThashCreate($$this{xid});
tie %$val, 'Stasis::Hash', $$this{xid}, $rid;
# Copy the scratch space into the tied hash.
foreach my $k (keys %h) {
$val{$k} = $h{$k}
}
# Insert the populated hashtable
Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $rid);
}
} else {
# XXX assumes the value is a scalar.
Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $val);
}
}
sub DELETE {
my $this = shift;
my $key = shift;
# This will leak hashes that were automatically created. Refcounts?
return Stasis::ThashRemove($$this{xid}, $$this{rid}, $key);
}
sub FIRSTKEY {
@ -75,7 +118,6 @@ sub FIRSTKEY {
sub NEXTKEY {
my $this = shift;
my $lastkey = shift;
print("."); $|=1;
Stasis::Titerator_tupleDone($$this{xid}, $$this{it});
if(Stasis::Titerator_next($$this{xid}, $$this{it})) {
return Stasis::Titerator_key($$this{xid}, $$this{it});
@ -92,6 +134,9 @@ sub CLEAR {
my $this = shift;
}
package Stasis::HashHeader;
@ISA = qw(Stasis::Recordid);
package Stasis;
__DATA__
@ -111,13 +156,16 @@ int TrecordSize(int xid, recordid rid);
static recordid recordid_SV(SV* sv) {
if(!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV)) {
printf("recordid_SV fail 1\n");
abort();
}
if (!(sv_isobject(sv) && sv_derived_from(sv, "Stasis::Recordid"))) {
printf("recordid_SV fail 2\n");
abort();
}
AV * av = (AV*)SvRV(sv);
if(av_len(av)+1 != 2) {
printf("recordid_SV fail 3\n");
abort();
}
SV ** pageSV = av_fetch(av, 0, 0);
@ -125,6 +173,7 @@ static recordid recordid_SV(SV* sv) {
if(!(pageSV && slotSV &&
*pageSV && *slotSV &&
SvIOK(*pageSV) && SvIOK(*slotSV))) {
printf("recordid_SV fail 4\n");
abort();
}
recordid rid = {
@ -148,6 +197,7 @@ static SV* SV_recordid(recordid rid) {
}
static byte * bytes_SV(SV* sv, STRLEN * sz) {
// XXX check for hashes, arrays?
byte * ret = 0;
IV valI;
NV valN;
@ -170,17 +220,21 @@ static byte * bytes_SV(SV* sv, STRLEN * sz) {
valP = (byte*)SvPV(sv,*sz); // string
tmp = valP;
code = 'P';
} else if (sv_isobject(sv) && sv_derived_from(sv, "Stasis::Recordid")) {
valR = recordid_SV(sv);
*sz = sizeof(recordid);
tmp = (byte*)&valR;
code = 'R';
} else if (sv_isobject(sv) && sv_derived_from(sv, "Stasis::Hash")) {
} else if (sv_isobject(sv) && sv_isa(sv, "Stasis::HashHeader")) {
valR = recordid_SV(sv);
*sz = sizeof(recordid);
tmp = (byte*)&valR;
code = 'H';
} else if (sv_isobject(sv) && sv_isa(sv, "Stasis::Recordid")) {
valR = recordid_SV(sv);
*sz = sizeof(recordid);
tmp = (byte*)&valR;
code = 'R';
} else if (sv_isobject(sv)) {
printf("Stasis.pm: Encountered unsupported object\n");
abort();
} else {
printf("Stasis.pm: Encountered unsupported SV\n");
abort();
}
// make room for code byte
@ -221,7 +275,7 @@ static SV * SV_bytes(byte* bytes, STRLEN sz) {
case 'H': {
assert(sz-1 == sizeof(recordid));
ret = SV_recordid(*(recordid*)bytes);
ret = sv_bless(ret, gv_stashpv("Stasis::Hash", GV_ADD));
ret = sv_bless(ret, gv_stashpv("Stasis::HashHeader", GV_ADD));
} break;
default: {
abort();
@ -269,7 +323,7 @@ recordid stasis_perl_TreadRecordid(int xid, recordid rid) {
/** Hash table */
recordid stasis_perl_ThashCreate(int xid) {
recordid stasis_perl_ThashCreateHelper(int xid) {
return ThashCreate(xid, VARIABLE_LENGTH, VARIABLE_LENGTH);
}

0
lang/perl/t/test.pl → lang/perl/t/01-boostrap.t
View file

0
lang/perl/t/test2.script → lang/perl/t/02-hash.script
View file

0
lang/perl/t/test2.pl → lang/perl/t/02-hash.t
View file

0
lang/perl/t/test3.pl → lang/perl/t/03-hash-iterator.t
View file