basis/inverse/inverse-tests.factor

   1 USING: inverse tools.test arrays math kernel sequences
   2 math.functions math.constants continuations ;
   3 IN: inverse-tests
   4
   5 [ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
   6 [ { 3 4 } [ dup 2array ] undo ] must-fail
   7
   8 TUPLE: foo bar baz ;
   9
  10 C: <foo> foo
  11
  12 [ 1 2 ] [ 1 2 <foo> [ <foo> ] undo ] unit-test
  13
  14 : 2same ( x -- {x,x} ) dup 2array ;
  15
  16 [ t ] [ { 3 3 } [ 2same ] matches? ] unit-test
  17 [ f ] [ { 3 4 } [ 2same ] matches? ] unit-test
  18 [ [ 2same ] matches? ] must-fail
  19
  20 : something ( array -- num )
  21     {
  22         { [ dup 1+ 2array ] [ 3 * ] }
  23         { [ 3array ] [ + + ] }
  24     } switch ;
  25
  26 [ 5 ] [ { 1 2 2 } something ] unit-test
  27 [ 6 ] [ { 2 3 } something ] unit-test
  28 [ { 1 } something ] must-fail
  29
  30 [ 1 2 [ eq? ] undo ] must-fail
  31
  32 : f>c ( *fahrenheit -- *celsius )
  33     32 - 1.8 / ;
  34
  35 [ { 212.0 32.0 } ] [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
  36 [ { t t f } ] [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
  37 [ { t f } ] [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
  38 [ 9 9 ] [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
  39 [ 5 ] [ 6 5 - [ 6 swap - ] undo ] unit-test
  40 [ 6 ] [ 6 5 - [ 5 - ] undo ] unit-test
  41
  42 TUPLE: cons car cdr ;
  43
  44 C: <cons> cons
  45
  46 TUPLE: nil ;
  47
  48 C: <nil> nil
  49
  50 : list-sum ( list -- sum )
  51     {
  52         { [ <cons> ] [ list-sum + ] }
  53         { [ <nil> ] [ 0 ] }
  54         [ "Malformed list" throw ]
  55     } switch ;
  56
  57 [ 10 ] [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
  58 [ ] [ <nil> [ <nil> ] undo ] unit-test
  59 [ 1 2 ] [ 1 2 <cons> [ <cons> ] undo ] unit-test
  60 [ t ] [ 1 2 <cons> [ <cons> ] matches? ] unit-test
  61 [ f ] [ 1 2 <cons> [ <foo> ] matches? ] unit-test
  62 [ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test
  63
  64 : empty-cons ( -- cons ) cons new ;
  65 : cons* ( cdr car -- cons ) cons boa ;
  66
  67 [ ] [ T{ cons f f f } [ empty-cons ] undo ] unit-test
  68 [ 1 2 ] [ 1 2 <cons> [ cons* ] undo ] unit-test
  69
  70 [ t ] [ pi [ pi ] matches? ] unit-test
  71 [ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
  72 [ ] [ 3 [ _ ] undo ] unit-test
  73
  74 [ 2.0 ] [ 2 3 ^ [ 3 ^ ] undo ] unit-test
  75 [ 3.0 ] [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
  76
  77 [ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
  78 [ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
  79 [ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
  80 [ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
  81
  82 [ [ sq ] ] [ [ sqrt ] [undo] ] unit-test
  83 [ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
  84 [ [ not ] ] [ [ not ] [undo] ] unit-test
  85 [ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test
  86
  87 TUPLE: funny-tuple ;
  88 : <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
  89 : funny-tuple ( -- ) "OOPS" throw ;
  90
  91 [ ] [ [ <funny-tuple> ] [undo] drop ] unit-test