extra/smalltalk/compiler/compiler-tests.factor

   1 USING: smalltalk.compiler tools.test prettyprint smalltalk.ast
   2 smalltalk.compiler.lexenv stack-checker locals.rewrite.closures
   3 kernel accessors compiler.units sequences arrays ;
   4 IN: smalltalk.compiler.tests
   5
   6 : test-compilation ( ast -- quot )
   7     [
   8         1array ast-sequence new swap >>body
   9         compile-smalltalk [ call ] append
  10     ] with-compilation-unit ;
  11
  12 : test-inference ( ast -- in# out# )
  13     test-compilation infer [ in>> ] [ out>> ] bi [ length ] bi@ ;
  14
  15 [ 2 1 ] [
  16     T{ ast-block f
  17        { "a" "b" }
  18        {
  19            T{ ast-message-send f
  20               T{ ast-name f "a" }
  21               "+"
  22               { T{ ast-name f "b" } }
  23            }
  24        }
  25     } test-inference
  26 ] unit-test
  27
  28 [ 3 1 ] [
  29     T{ ast-block f
  30        { "a" "b" "c" }
  31        {
  32            T{ ast-assignment f
  33               T{ ast-name f "a" }
  34               T{ ast-message-send f
  35                  T{ ast-name f "c" }
  36                  "+"
  37                  { T{ ast-name f "b" } }
  38               }
  39            }
  40            T{ ast-message-send f
  41               T{ ast-name f "b" }
  42               "blah:"
  43               { 123.456 }
  44            }
  45            T{ ast-return f T{ ast-name f "c" } }
  46        }
  47     } test-inference
  48 ] unit-test
  49
  50 [ 0 1 ] [
  51     T{ ast-block f
  52        { }
  53        { }
  54        {
  55            T{ ast-message-send
  56               { receiver 1 }
  57               { selector "to:do:" }
  58               { arguments
  59                 {
  60                     10
  61                     T{ ast-block
  62                        { arguments { "i" } }
  63                        { body
  64                          {
  65                              T{ ast-message-send
  66                                 { receiver
  67                                   T{ ast-name { name "i" } }
  68                                 }
  69                                 { selector "print" }
  70                              }
  71                          }
  72                        }
  73                     }
  74                 }
  75               }
  76            }
  77        }
  78     } test-inference
  79 ] unit-test
  80
  81 [ "a" ] [
  82     T{ ast-block f
  83        { }
  84        { }
  85        { { T{ ast-block { body { "a" } } } } }
  86     } test-compilation call first call
  87 ] unit-test