basis/stack-checker/transforms/transforms-tests.factor

   1 IN: stack-checker.transforms.tests
   2 USING: sequences stack-checker.transforms tools.test math kernel
   3 quotations stack-checker stack-checker.errors accessors
   4 combinators words arrays classes classes.tuple macros ;
   5
   6 MACRO: compose-n ( n word -- quot' ) <repetition> >quotation ;
   7
   8 : compose-n-test ( a b c -- x ) 2 \ + compose-n ;
   9
  10 { 6 } [ 1 2 3 compose-n-test ] unit-test
  11
  12 TUPLE: color r g b ;
  13
  14 C: <color> color
  15
  16 : cleave-test ( color -- r g b )
  17     { [ r>> ] [ g>> ] [ b>> ] } cleave ;
  18
  19 { 1 3 } [ cleave-test ] must-infer-as
  20
  21 { 1 2 3 } [ 1 2 3 <color> cleave-test ] unit-test
  22
  23 { 1 2 3 } [ 1 2 3 <color> \ cleave-test def>> call ] unit-test
  24
  25 : 2cleave-test ( a b -- c d e ) { [ 2array ] [ + ] [ - ] } 2cleave ;
  26
  27 { { 1 2 } 3 -1 } [ 1 2 2cleave-test ] unit-test
  28
  29 { { 1 2 } 3 -1 } [ 1 2 \ 2cleave-test def>> call ] unit-test
  30
  31 : spread-test ( a b c -- d e f ) { [ sq ] [ neg ] [ recip ] } spread ;
  32
  33 { 16 -3 1/6 } [ 4 3 6 spread-test ] unit-test
  34
  35 { 16 -3 1/6 } [ 4 3 6 \ spread-test def>> call ] unit-test
  36
  37 [ fixnum instance? ] must-infer
  38
  39 : bad-new-test ( -- obj ) V{ } new ;
  40
  41 [ bad-new-test ] must-infer
  42
  43 [ bad-new-test ] must-fail
  44
  45 ! Corner case if macro expansion calls 'infer', found by Doug
  46 DEFER: smart-combo
  47
  48 \ smart-combo [ infer [ ] curry ] 1 define-transform
  49
  50 [ [ "a" "b" "c" ] smart-combo ] must-infer
  51
  52 [ [ [ "a" "b" ] smart-combo "c" ] smart-combo ] must-infer
  53
  54 : very-smart-combo ( quot -- ) smart-combo ; inline
  55
  56 [ [ "a" "b" "c" ] very-smart-combo ] must-infer
  57
  58 [ [ [ "a" "b" ] very-smart-combo "c" ] very-smart-combo ] must-infer
  59
  60 ! Caveat found by Doug
  61 MACRO: curry-folding-test ( quot -- )
  62     length \ drop <repetition> >quotation ;
  63
  64 { 3 0 } [ [ 1 2 3 ] curry-folding-test ] must-infer-as
  65 { 3 0 } [ 1 [ 2 3 ] curry curry-folding-test ] must-infer-as
  66 { 3 0 } [ [ 1 2 ] 3 [ ] curry compose curry-folding-test ] must-infer-as
  67
  68 [ [ curry curry-folding-test ] infer ]
  69 [ T{ unknown-macro-input f curry-folding-test } = ] must-fail-with
  70
  71 : member?-test ( a -- ? ) { 1 2 3 10 7 58 } member? ;
  72
  73 { f } [ 1.0 member?-test ] unit-test
  74 { t } [ \ member?-test def>> first [ member?-test ] all? ] unit-test
  75
  76 ! Macro expansion should throw its own type of error
  77 : bad-macro ( -- ) ;
  78
  79 \ bad-macro [ "OOPS" throw ] 0 define-transform
  80
  81 [ [ bad-macro ] infer ] [ [ transform-expansion-error? ] [ error>> "OOPS" = ] [ word>> \ bad-macro = ] tri and and ] must-fail-with
  82
  83 MACRO: two-params ( a b -- c ) + 1quotation ;
  84
  85 [ [ 3 two-params ] infer ] [ T{ unknown-macro-input f two-params } = ] must-fail-with