Merge branch 'master' of git://factorcode.org/git/factor
commit
1c13b4164c
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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,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));
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue