extra/smalltalk/parser/parser-tests.factor

   1 USING: smalltalk.parser smalltalk.ast peg.ebnf tools.test accessors
   2 io.files io.encodings.ascii kernel multiline ;
   3 IN: smalltalk.parser.tests
   4
   5 EBNF: test-Character [=[
   6 test         = <foreign parse-smalltalk Character>
   7 ]=]
   8
   9 { CHAR: a } [ "a" test-Character ] unit-test
  10
  11 EBNF: test-Comment [=[
  12 test         = <foreign parse-smalltalk Comment>
  13 ]=]
  14
  15 { T{ ast-comment f "Hello, this is a comment." } }
  16 [ "\"Hello, this is a comment.\"" test-Comment ]
  17 unit-test
  18
  19 { T{ ast-comment f "Hello, \"this\" is a comment." } }
  20 [ "\"Hello, \"\"this\"\" is a comment.\"" test-Comment ]
  21 unit-test
  22
  23 EBNF: test-Identifier [=[
  24 test         = <foreign parse-smalltalk Identifier>
  25 ]=]
  26
  27 { "OrderedCollection" } [ "OrderedCollection" test-Identifier ] unit-test
  28
  29 EBNF: test-Literal [=[
  30 test         = <foreign parse-smalltalk Literal>
  31 ]=]
  32
  33 { nil } [ "nil" test-Literal ] unit-test
  34 { 123 } [ "123" test-Literal ] unit-test
  35 { 0xdeadbeef } [ "16rdeadbeef" test-Literal ] unit-test
  36 { -123 } [ "-123" test-Literal ] unit-test
  37 { 1.2 } [ "1.2" test-Literal ] unit-test
  38 { -1.24 } [ "-1.24" test-Literal ] unit-test
  39 { 12.4e7 } [ "12.4e7" test-Literal ] unit-test
  40 { 12.4e-7 } [ "12.4e-7" test-Literal ] unit-test
  41 { -12.4e7 } [ "-12.4e7" test-Literal ] unit-test
  42 { CHAR: x } [ "$x" test-Literal ] unit-test
  43 { "Hello, world" } [ "'Hello, world'" test-Literal ] unit-test
  44 { "Hello, 'funny' world" } [ "'Hello, ''funny'' world'" test-Literal ] unit-test
  45 { T{ symbol f "foo" } } [ "#foo" test-Literal ] unit-test
  46 { T{ symbol f "+" } } [ "#+" test-Literal ] unit-test
  47 { T{ symbol f "at:put:" } } [ "#at:put:" test-Literal ] unit-test
  48 { T{ symbol f "Hello world" } } [ "#'Hello world'" test-Literal ] unit-test
  49 { B{ 1 2 3 4 } } [ "#[1 2 3 4]" test-Literal ] unit-test
  50 { { nil t f } } [ "#(nil true false)" test-Literal ] unit-test
  51 { { nil { t f } } } [ "#(nil (true false))" test-Literal ] unit-test
  52 { T{ ast-block f { } { } { } } } [ "[]" test-Literal ] unit-test
  53 { T{ ast-block f { "x" } { } { T{ ast-return f T{ ast-name f "x" } } } } } [ "[ :x|^x]" test-Literal ] unit-test
  54 { T{ ast-block f { } { } { T{ ast-return f self } } } } [ "[^self]" test-Literal ] unit-test
  55
  56 {
  57     T{ ast-block
  58        { arguments { "i" } }
  59        { body
  60          {
  61              T{ ast-message-send
  62                 { receiver T{ ast-name { name "i" } } }
  63                 { selector "print" }
  64              }
  65          }
  66        }
  67     }
  68 }
  69 [ "[ :i | i print ]" test-Literal ] unit-test
  70
  71 {
  72     T{ ast-block
  73        { body { 5 self } }
  74     }
  75 }
  76 [ "[5. self]" test-Literal ] unit-test
  77
  78 EBNF: test-FormalBlockArgumentDeclarationList [=[
  79 test         = <foreign parse-smalltalk FormalBlockArgumentDeclarationList>
  80 ]=]
  81
  82 { V{ "x" "y" "elt" } } [ ":x :y :elt" test-FormalBlockArgumentDeclarationList ] unit-test
  83
  84 EBNF: test-Operand [=[
  85 test         = <foreign parse-smalltalk Operand>
  86 ]=]
  87
  88 { { 123 15.6 { t f } } } [ "#(123 15.6 (true false))" test-Operand ] unit-test
  89 { T{ ast-name f "x" } } [ "x" test-Operand ] unit-test
  90
  91 EBNF: test-Expression [=[
  92 test         = <foreign parse-smalltalk Expression>
  93 ]=]
  94
  95 { self } [ "self" test-Expression ] unit-test
  96 { { 123 15.6 { t f } } } [ "#(123 15.6 (true false))" test-Expression ] unit-test
  97 { T{ ast-name f "x" } } [ "x" test-Expression ] unit-test
  98 { T{ ast-message-send f 5 "print" { } } } [ "5 print" test-Expression ] unit-test
  99 { T{ ast-message-send f T{ ast-message-send f 5 "squared" { } } "print" { } } } [ "5 squared print" test-Expression ] unit-test
 100 { T{ ast-message-send f 2 "+" { 2 } } } [ "2+2" test-Expression ] unit-test
 101
 102 {
 103     T{ ast-message-send f
 104         T{ ast-message-send f 3 "factorial" { } }
 105         "+"
 106         { T{ ast-message-send f 4 "factorial" { } } }
 107     }
 108 }
 109 [ "3 factorial + 4 factorial" test-Expression ] unit-test
 110
 111 {
 112     T{ ast-message-send f
 113         T{ ast-message-send f 3 "factorial" { } }
 114         "+"
 115         { T{ ast-message-send f 4 "factorial" { } } }
 116     }
 117 }
 118 [ "   3 factorial + 4 factorial" test-Expression ] unit-test
 119
 120 {
 121     T{ ast-message-send f
 122         T{ ast-message-send f 3 "factorial" { } }
 123         "+"
 124         { T{ ast-message-send f 4 "factorial" { } } }
 125     }
 126 }
 127 [ "   3 factorial + 4 factorial     " test-Expression ] unit-test
 128
 129 {
 130     T{ ast-message-send f
 131         T{ ast-message-send f
 132             T{ ast-message-send f 3 "factorial" { } }
 133             "+"
 134             { 4 }
 135         }
 136         "factorial"
 137         { }
 138     }
 139 }
 140 [ "(3 factorial + 4) factorial" test-Expression ] unit-test
 141
 142 {
 143     T{ ast-message-send
 144        { receiver
 145          T{ ast-message-send
 146             { receiver
 147               T{ ast-message-send
 148                  { receiver 1 }
 149                  { selector "<" }
 150                  { arguments { 10 } }
 151               }
 152             }
 153             { selector "ifTrue:ifFalse:" }
 154             { arguments
 155               {
 156                   T{ ast-block { body { "HI" } } }
 157                   T{ ast-block { body { "BYE" } } }
 158               }
 159             }
 160          }
 161        }
 162        { selector "print" }
 163     }
 164 }
 165 [ "((1 < 10) ifTrue: [ 'HI' ] ifFalse: [ 'BYE' ]) print" test-Expression ] unit-test
 166
 167 {
 168     T{ ast-cascade
 169        { receiver 12 }
 170        { messages
 171          {
 172            T{ ast-message f "sqrt" }
 173            T{ ast-message f "+" { 2 } }
 174          }
 175        }
 176     }
 177 }
 178 [ "12 sqrt; + 2" test-Expression ] unit-test
 179
 180 {
 181     T{ ast-cascade
 182        { receiver T{ ast-message-send f 12 "sqrt" } }
 183        { messages
 184          {
 185            T{ ast-message f "+" { 1 } }
 186            T{ ast-message f "+" { 2 } }
 187          }
 188        }
 189     }
 190 }
 191 [ "12 sqrt + 1; + 2" test-Expression ] unit-test
 192
 193 {
 194     T{ ast-cascade
 195        { receiver T{ ast-message-send f 12 "squared" } }
 196        { messages
 197          {
 198            T{ ast-message f "to:" { 100 } }
 199            T{ ast-message f "sqrt" }
 200          }
 201        }
 202     }
 203 }
 204 [ "12 squared to: 100; sqrt" test-Expression ] unit-test
 205
 206 {
 207     T{ ast-message-send f
 208         T{ ast-message-send f 1 "+" { 2 } }
 209         "*"
 210         { 3 }
 211     }
 212 }
 213 [ "1+2*3" test-Expression ] unit-test
 214
 215 {
 216     T{ ast-message-send
 217        { receiver
 218          T{ ast-message-send
 219             { receiver { T{ ast-block { body { "a" } } } } }
 220             { selector "at:" }
 221             { arguments { 0 } }
 222          }
 223        }
 224        { selector "value" }
 225     }
 226 }
 227 [ "(#(['a']) at: 0) value" test-Expression ] unit-test
 228
 229 EBNF: test-FinalStatement [=[
 230 test         = <foreign parse-smalltalk FinalStatement>
 231 ]=]
 232
 233 { T{ ast-name f "value" } } [ "value" test-FinalStatement ] unit-test
 234 { T{ ast-return f T{ ast-name f "value" } } } [ "^value" test-FinalStatement ] unit-test
 235 { T{ ast-assignment f T{ ast-name f "value" } 5 } } [ "value:=5" test-FinalStatement ] unit-test
 236
 237 EBNF: test-LocalVariableDeclarationList [=[
 238 test         = <foreign parse-smalltalk LocalVariableDeclarationList>
 239 ]=]
 240
 241 { T{ ast-local-variables f { "i" "j" } } } [ " |  i j   |" test-LocalVariableDeclarationList ] unit-test
 242
 243
 244 { T{ ast-message-send f T{ ast-name f "x" } "foo:bar:" { 1 2 } } }
 245 [ "x foo:1 bar:2" test-Expression ] unit-test
 246
 247 {
 248     T{ ast-message-send
 249         f
 250         T{ ast-message-send f
 251             T{ ast-message-send f 3 "factorial" { } }
 252             "+"
 253             { T{ ast-message-send f 4 "factorial" { } } }
 254         }
 255         "between:and:"
 256         { 10 100 }
 257     }
 258 }
 259 [ "3 factorial + 4 factorial between: 10 and: 100" test-Expression ] unit-test
 260
 261 { T{ ast-sequence f { } { 1 2 } } } [ "1. 2" parse-smalltalk ] unit-test
 262
 263 { T{ ast-sequence f { } { 1 2 } } } [ "1. 2." parse-smalltalk ] unit-test
 264
 265 {
 266     T{ ast-sequence f { }
 267         {
 268             T{ ast-class
 269                { name "Test" }
 270                { superclass "Object" }
 271                { ivars { "a" } }
 272             }
 273         }
 274     }
 275 }
 276 [ "class Test [|a|]" parse-smalltalk ] unit-test
 277
 278 {
 279     T{ ast-sequence f { }
 280         {
 281             T{ ast-class
 282                { name "Test1" }
 283                { superclass "Object" }
 284                { ivars { "a" } }
 285             }
 286
 287             T{ ast-class
 288                { name "Test2" }
 289                { superclass "Test1" }
 290                { ivars { "b" } }
 291             }
 292         }
 293     }
 294 }
 295 [ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
 296
 297 [ "class Foo []. Tests blah " parse-smalltalk ] must-not-fail
 298
 299 [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk ] must-not-fail
 300
 301 [ "_abc_" parse-smalltalk ] must-not-fail