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

Fixing some unit test failures

db4
Slava Pestov 2009-04-06 03:30:23 -05:00
parent 3af8643c30
commit 0f04061079
4 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/prettyprint/prettyprint-tests.factor
View File

@ -278,11 +278,7 @@ GENERIC: generic-see-test-with-f ( obj -- obj )
M: f generic-see-test-with-f ; M: f generic-see-test-with-f ;
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [ [ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
[ { POSTPONE: f generic-see-test-with-f } see ] with-string-writer [ M\ f generic-see-test-with-f see ] with-string-writer
] unit-test
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
[ \ f \ generic-see-test-with-f method see ] with-string-writer
] unit-test ] unit-test
PREDICATE: predicate-see-test < integer even? ; PREDICATE: predicate-see-test < integer even? ;
@ -309,5 +305,5 @@ GENERIC: ended-up-ballin' ( a -- b )
M: started-out-hustlin' ended-up-ballin' ; inline M: started-out-hustlin' ended-up-ballin' ; inline
[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [ [ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
[ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer [ M\ started-out-hustlin' ended-up-ballin' see ] with-string-writer
] unit-test ] unit-test

8
core/words/constant/constant-tests.factor
View File

@ -1,10 +1,12 @@
IN: words.constant.tests IN: words.constant.tests
USING: tools.test math ; USING: tools.test math words.constant ;
CONSTANT: a + CONSTANT: a +
[ + ] [ a ] unit-test [ + ] [ a ] unit-test
[ t ] [ \ a constant? ] unit-test
CONSTANT: b \ + CONSTANT: b \ +
[ \ + ] [ b ] unit-test [ \ + ] [ b ] unit-test
@ -12,3 +14,7 @@ CONSTANT: b \ +
CONSTANT: c { 1 2 3 } CONSTANT: c { 1 2 3 }
[ { 1 2 3 } ] [ c ] unit-test [ { 1 2 3 } ] [ c ] unit-test
SYMBOL: foo
[ f ] [ \ foo constant? ] unit-test

11
core/words/constant/constant.factor
View File

@ -3,12 +3,15 @@
USING: accessors kernel sequences words definitions quotations ; USING: accessors kernel sequences words definitions quotations ;
IN: words.constant IN: words.constant
PREDICATE: constant < word ( obj -- ? ) PREDICATE: constant < word "constant" word-prop >boolean ;
def>> dup length 1 = [ first word? not ] [ drop f ] if ;
: define-constant ( word value -- ) : define-constant ( word value -- )
[ ] curry (( -- value )) define-inline ; [ "constant" set-word-prop ]
[ [ ] curry (( -- value )) define-inline ] 2bi ;
M: constant reset-word
[ call-next-method ] [ f "constant" set-word-prop ] bi ;
M: constant definer drop \ CONSTANT: f ; M: constant definer drop \ CONSTANT: f ;
M: constant definition def>> first literalize 1quotation ; M: constant definition "constant" word-prop literalize 1quotation ;

7
core/words/symbol/symbol.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors definitions USING: kernel sequences accessors definitions words ;
words words.constant ;
IN: words.symbol IN: words.symbol
PREDICATE: symbol < constant ( obj -- ? ) PREDICATE: symbol < word ( obj -- ? )
[ def>> ] [ [ ] curry ] bi sequence= ; [ def>> ] [ [ ] curry ] bi sequence= ;
M: symbol definer drop \ SYMBOL: f ; M: symbol definer drop \ SYMBOL: f ;
@ -12,4 +11,4 @@ M: symbol definer drop \ SYMBOL: f ;
M: symbol definition drop f ; M: symbol definition drop f ;
: define-symbol ( word -- ) : define-symbol ( word -- )
dup define-constant ; dup [ ] curry (( -- value )) define-inline ;