extra/smalltalk/compiler/compiler-tests.factor

   1 USING: smalltalk.compiler tools.test prettyprint smalltalk.ast
   2 smalltalk.compiler.lexenv stack-checker locals.rewrite
   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 2length ;
  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 T{ ast-name { name "i" } } }
  67                                         { selector "print" }
  68                                     }
  69                                 }
  70                             }
  71                         }
  72                     }
  73                 }
  74             }
  75        }
  76     } test-inference
  77 ] unit-test
  78
  79 { "a" } [
  80     T{ ast-block f
  81         { }
  82         { }
  83         { { T{ ast-block { body { "a" } } } } }
  84     } test-compilation call first call
  85 ] unit-test