extra/smalltalk/parser/parser-tests.factor

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