unmaintained/advice/advice-tests.factor

   1 ! Copyright (C) 2008 James Cash
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences io io.streams.string math tools.test advice math.parser
   4 parser namespaces multiline eval words assocs ;
   5 IN: advice.tests
   6
   7 [
   8     [ ad-do-it ] must-fail
   9
  10     : foo ( -- str ) "foo" ;
  11     \ foo make-advised
  12
  13     { "bar" "foo" } [
  14         [ "bar" ] "barify" \ foo advise-before
  15         foo
  16     ] unit-test
  17
  18     { "bar" "foo" "baz" } [
  19         [ "baz" ] "bazify" \ foo advise-after
  20         foo
  21     ] unit-test
  22
  23     { "foo" "baz" } [
  24         "barify" \ foo before remove-advice
  25         foo
  26     ] unit-test
  27
  28     : bar ( a -- b ) 1 + ;
  29     \ bar make-advised
  30
  31     { 11 } [
  32         [ 2 * ] "double" \ bar advise-before
  33         5 bar
  34     ] unit-test
  35
  36     { 11/3 } [
  37         [ 3 / ] "third" \ bar advise-after
  38         5 bar
  39     ] unit-test
  40
  41     { -2 } [
  42         [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around
  43         5 bar
  44     ] unit-test
  45
  46     : add ( a b -- c ) + ;
  47     \ add make-advised
  48
  49     { 10 } [
  50         [ [ 2 * ] bi@ ] "double-args" \ add advise-before
  51         2 3 add
  52     ] unit-test
  53
  54     { 21 } [
  55         [ 3 * ad-do-it 1- ] "around1" \ add advise-around
  56         2 3 add
  57     ] unit-test
  58
  59 !     { 9 } [
  60 !         [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around
  61 !         2 3 add
  62 !     ] unit-test
  63
  64 !     { { "around1" "around2" } } [
  65 !         \ add around word-prop keys
  66 !     ] unit-test
  67
  68     { 5 f } [
  69         \ add unadvise
  70         2 3 add \ add advised?
  71     ] unit-test
  72
  73 !     : quux ( a b -- c ) * ;
  74
  75 !     { f t 3+3/4 } [
  76 !         <" USING: advice kernel math ;
  77 !            IN: advice.tests
  78 !            \ quux advised?
  79 !            ADVISE: quux halve before [ 2 / ] bi@ ;
  80 !            \ quux advised?
  81 !            3 5 quux"> eval
  82 !     ] unit-test
  83
  84 !     { 3+3/4 "1+1/2 2+1/2 3+3/4" } [
  85 !         <" USING: advice kernel math math.parser io io.streams.string ;
  86 !            IN: advice.tests
  87 !            ADVISE: quux log around
  88 !            2dup [ number>string write " " write ] bi@
  89 !            ad-do-it
  90 !            dup number>string write ;
  91 !            [ 3 5 quux ] with-string-writer"> eval
  92 !     ] unit-test
  93
  94 ] with-scope