diff --git a/extra/db/tuples/tuples-tests.factor b/extra/db/tuples/tuples-tests.factor index b7c6fce933..fa213efb2f 100755 --- a/extra/db/tuples/tuples-tests.factor +++ b/extra/db/tuples/tuples-tests.factor @@ -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 diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index 10010ba759..ad581d927c 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -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 ; diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index 8dbf6786bc..03e6b15bdb 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -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 ; diff --git a/vm/profiler.c b/vm/profiler.c index 08bb846c85..58a4aa035e 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -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)); }