diff --git a/extra/advice/advice-tests.factor b/extra/advice/advice-tests.factor index b359d5596f..ece4cb52a7 100644 --- a/extra/advice/advice-tests.factor +++ b/extra/advice/advice-tests.factor @@ -1,64 +1,93 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences math tools.test advice parser namespaces ; +USING: kernel sequences io io.streams.string math tools.test advice math.parser +parser namespaces multiline eval words assocs ; IN: advice.tests [ -: foo "foo" ; -\ foo make-advised + [ ad-do-it ] must-fail + + : foo "foo" ; + \ foo make-advised - { "bar" "foo" } [ - [ "bar" ] "barify" \ foo advise-before - foo ] unit-test + { "bar" "foo" } [ + [ "bar" ] "barify" \ foo advise-before + foo + ] unit-test - { "bar" "foo" "baz" } [ - [ "baz" ] "bazify" \ foo advise-after - foo ] unit-test + { "bar" "foo" "baz" } [ + [ "baz" ] "bazify" \ foo advise-after + foo + ] unit-test - { "foo" "baz" } [ - "barify" \ foo before remove-advice - foo ] unit-test + { "foo" "baz" } [ + "barify" \ foo before remove-advice + foo + ] unit-test -: bar ( a -- b ) 1+ ; -\ bar make-advised + : bar ( a -- b ) 1+ ; + \ bar make-advised - { 11 } [ - [ 2 * ] "double" \ bar advise-before - 5 bar - ] unit-test + { 11 } [ + [ 2 * ] "double" \ bar advise-before + 5 bar + ] unit-test - { 11/3 } [ - [ 3 / ] "third" \ bar advise-after - 5 bar - ] unit-test + { 11/3 } [ + [ 3 / ] "third" \ bar advise-after + 5 bar + ] unit-test - { -2 } [ - [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around - 5 bar - ] unit-test + { -2 } [ + [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around + 5 bar + ] unit-test -: add ( a b -- c ) + ; -\ add make-advised + : add ( a b -- c ) + ; + \ add make-advised - { 10 } [ - [ [ 2 * ] bi@ ] "double-args" \ add advise-before - 2 3 add - ] unit-test + { 10 } [ + [ [ 2 * ] bi@ ] "double-args" \ add advise-before + 2 3 add + ] unit-test - { 21 } [ - [ 3 * ad-do-it 1- ] "around1" \ add advise-around - 2 3 add - ] unit-test + { 21 } [ + [ 3 * ad-do-it 1- ] "around1" \ add advise-around + 2 3 add + ] unit-test - { 9 } [ - [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around - 2 3 add - ] unit-test + { 9 } [ + [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around + 2 3 add + ] unit-test - { 5 } [ - \ add unadvise - 2 3 add - ] unit-test + { { "around1" "around2" } } [ + \ add around word-prop keys + ] unit-test + { 5 f } [ + \ add unadvise + 2 3 add \ add advised? + ] unit-test + + : quux ( a b -- c ) * ; + + { f t 3+3/4 } [ + <" USING: advice kernel math ; + IN: advice.tests + \ quux advised? + ADVISE: quux halve before [ 2 / ] bi@ ; + \ quux advised? + 3 5 quux"> eval + ] unit-test + + { 3+3/4 "1+1/2 2+1/2 3+3/4" } [ + <" USING: advice kernel math math.parser io io.streams.string ; IN: advice.tests + ADVISE: quux log around + 2dup [ number>string write " " write ] bi@ + ad-do-it + dup number>string write ; + [ 3 5 quux ] with-string-writer"> eval + ] unit-test - ] with-scope \ No newline at end of file +] with-scope \ No newline at end of file