factor/extra/advice/advice-tests.factor

94 lines
2.1 KiB
Factor

! Copyright (C) 2008 James Cash
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences io io.streams.string math tools.test advice math.parser
parser namespaces multiline eval words assocs ;
IN: advice.tests
[
[ ad-do-it ] must-fail
: foo "foo" ;
\ foo make-advised
{ "bar" "foo" } [
[ "bar" ] "barify" \ foo advise-before
foo
] unit-test
{ "bar" "foo" "baz" } [
[ "baz" ] "bazify" \ foo advise-after
foo
] unit-test
{ "foo" "baz" } [
"barify" \ foo before remove-advice
foo
] unit-test
: bar ( a -- b ) 1+ ;
\ bar make-advised
{ 11 } [
[ 2 * ] "double" \ bar advise-before
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
: add ( a b -- c ) + ;
\ add make-advised
{ 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
! { 9 } [
! [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around
! 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