steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-05-30 18:07:47 -05:00
parent 72c914ddfa cc662c94ed
commit 1c13b4164c
4 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/db/tuples/tuples-tests.factor
View File

@ -198,9 +198,10 @@ TUPLE: annotation n paste-id summary author mode contents ;
: test-sqlite ( quot -- )
>r "tuples-test.db" temp-file sqlite-db r> with-db ;
: test-postgresql ( -- )
>r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
! : test-postgresql ( quot -- )
! >r { "localhost" "postgres" "foob" "factor-test" } postgresql-db r> with-db ;
: test-postgresql drop ;
: test-repeated-insert
[ ] [ person ensure-table ] unit-test
[ ] [ person1 get insert-tuple ] unit-test
@ -415,7 +416,7 @@ TUPLE: does-not-persist ;
] test-postgresql
TUPLE: suparclass a ;
TUPLE: suparclass id a ;
suparclass f {
{ "id" "ID" +db-assigned-id+ }
@ -429,7 +430,16 @@ subbclass "SUBCLASS" {
} define-persistent
: test-db-inheritance ( -- )
[ ] [ subbclass ensure-table ] unit-test ;
[ ] [ subbclass ensure-table ] unit-test
[ ] [
subbclass new 5 >>a "hi" >>b dup insert-tuple id>> "id" set
] unit-test
[ t "hi" 5 ] [
subbclass new "id" get >>id select-tuple
[ subbclass? ] [ b>> ] [ a>> ] tri
] unit-test ;
[ test-db-inheritance ] test-sqlite

4
extra/db/tuples/tuples.factor
View File

@ -13,10 +13,10 @@ IN: db.tuples
"db-columns" set-word-prop
"db-relations" set-word-prop ;
ERROR: not-persistent ;
ERROR: not-persistent class ;
: db-table ( class -- obj )
"db-table" word-prop [ not-persistent ] unless* ;
dup "db-table" word-prop [ ] [ not-persistent ] ?if ;
: db-columns ( class -- obj )
superclasses [ "db-columns" word-prop ] map concat ;

3
extra/db/types/types.factor
View File

@ -142,7 +142,8 @@ HOOK: bind% db ( spec -- )
HOOK: bind# db ( spec obj -- )
: offset-of-slot ( str obj -- n )
class "slots" word-prop slot-named slot-spec-offset ;
class superclasses [ "slots" word-prop ] map concat
slot-named slot-spec-offset ;
: get-slot-named ( name obj -- value )
tuck offset-of-slot slot ;

11
vm/profiler.c
View File

@ -11,11 +11,12 @@ F_COMPILED *compile_profiling_stub(F_WORD *word)
CELL code = array_nth(quadruple,0);
REGISTER_ROOT(code);
CELL rel_type = allot_cell(to_fixnum(array_nth(quadruple,2))
| (to_fixnum(array_nth(quadruple,1)) << 8));
CELL rel_offset = array_nth(quadruple,3) * compiled_code_format();
F_REL rel;
rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8);
rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format();
CELL relocation = allot_array_2(rel_type,rel_offset);
F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL));
memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL));
UNREGISTER_ROOT(code);
UNREGISTER_ROOT(literals);
@ -24,7 +25,7 @@ F_COMPILED *compile_profiling_stub(F_WORD *word)
WORD_TYPE,
untag_object(code),
NULL, /* no labels */
untag_object(relocation),
tag_object(relocation),
untag_object(literals));
}