core/parser/parser-tests.factor

   1 USING: arrays math parser tools.test kernel generic words
   2 io.streams.string namespaces classes effects source-files
   3 assocs sequences strings io.files definitions continuations
   4 sorting classes.tuple compiler.units debugger vocabs
   5 vocabs.loader accessors eval combinators ;
   6 IN: parser.tests
   7
   8 [
   9     [ 1 [ 2 [ 3 ] 4 ] 5 ]
  10     [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
  11     unit-test
  12
  13     [ t t f f ]
  14     [ "t t f f" eval ]
  15     unit-test
  16
  17     [ "hello world" ]
  18     [ "\"hello world\"" eval ]
  19     unit-test
  20
  21     [ "\n\r\t\\" ]
  22     [ "\"\\n\\r\\t\\\\\"" eval ]
  23     unit-test
  24
  25     [ "hello world" ]
  26     [
  27         "IN: parser.tests : hello \"hello world\" ;"
  28         eval "USE: parser.tests hello" eval
  29     ] unit-test
  30
  31     [ ]
  32     [ "! This is a comment, people." eval ]
  33     unit-test
  34
  35     ! Test escapes
  36
  37     [ " " ]
  38     [ "\"\\u000020\"" eval ]
  39     unit-test
  40
  41     [ "'" ]
  42     [ "\"\\u000027\"" eval ]
  43     unit-test
  44
  45     ! Test EOL comments in multiline strings.
  46     [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test
  47
  48     [ word ] [ \ f class ] unit-test
  49
  50     ! Test stack effect parsing
  51
  52     : effect-parsing-test ( a b -- c ) + ;
  53
  54     [ t ] [
  55         "effect-parsing-test" "parser.tests" lookup
  56         \ effect-parsing-test eq?
  57     ] unit-test
  58
  59     [ T{ effect f { "a" "b" } { "c" } f } ]
  60     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  61
  62     : baz ( a b -- * ) 2array throw ;
  63
  64     [ t ]
  65     [ \ baz "declared-effect" word-prop terminated?>> ]
  66     unit-test
  67
  68     [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test
  69
  70     [ t ] [
  71         "effect-parsing-test" "parser.tests" lookup
  72         \ effect-parsing-test eq?
  73     ] unit-test
  74
  75     [ T{ effect f { "a" "b" } { "d" } f } ]
  76     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  77
  78     [ ] [ "IN: parser.tests : effect-parsing-test ;" eval ] unit-test
  79
  80     [ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  81
  82     ! Funny bug
  83     [ 2 ] [ "IN: parser.tests : \0. 2 ; \0." eval ] unit-test
  84
  85     [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail
  86
  87     ! These should throw errors
  88     [ "HEX: zzz" eval ] must-fail
  89     [ "OCT: 999" eval ] must-fail
  90     [ "BIN: --0" eval ] must-fail
  91
  92     ! Another funny bug
  93     [ t ] [
  94         [
  95             "scratchpad" in set
  96             { "scratchpad" "arrays" } set-use
  97             [
  98                 ! This shouldn't modify in/use in the outer scope!
  99             ] with-file-vocabs
 100
 101             use get { "scratchpad" "arrays" } set-use use get =
 102         ] with-scope
 103     ] unit-test
 104     DEFER: foo
 105
 106     "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
 107
 108     [ ] [ "USE: parser.tests foo" eval ] unit-test
 109
 110     "IN: parser.tests USING: math prettyprint ; : foo 2 2 + . ;" eval
 111
 112     [ t ] [
 113         "USE: parser.tests \\ foo" eval
 114         "foo" "parser.tests" lookup eq?
 115     ] unit-test
 116
 117     ! Test smudging
 118
 119     [ 1 ] [
 120         "IN: parser.tests : smudge-me ;" <string-reader> "foo"
 121         parse-stream drop
 122
 123         "foo" source-file definitions>> first assoc-size
 124     ] unit-test
 125
 126     [ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
 127
 128     [ ] [
 129         "IN: parser.tests : smudge-me-more ;" <string-reader> "foo"
 130         parse-stream drop
 131     ] unit-test
 132
 133     [ t ] [ "smudge-me-more" "parser.tests" lookup >boolean ] unit-test
 134     [ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test
 135
 136     [ 3 ] [
 137         "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
 138         parse-stream drop
 139
 140         "foo" source-file definitions>> first assoc-size
 141     ] unit-test
 142
 143     [ 1 ] [
 144         "IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
 145         parse-stream drop
 146
 147         "bar" source-file definitions>> first assoc-size
 148     ] unit-test
 149
 150     [ 2 ] [
 151         "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" <string-reader> "foo"
 152         parse-stream drop
 153
 154         "foo" source-file definitions>> first assoc-size
 155     ] unit-test
 156
 157     [ t ] [
 158         array "smudge-me" "parser.tests" lookup order memq?
 159     ] unit-test
 160
 161     [ t ] [
 162         integer "smudge-me" "parser.tests" lookup order memq?
 163     ] unit-test
 164
 165     [ f ] [
 166         string "smudge-me" "parser.tests" lookup order memq?
 167     ] unit-test
 168
 169     [ ] [
 170         "IN: parser.tests USE: math 2 2 +" <string-reader> "a"
 171         parse-stream drop
 172     ] unit-test
 173
 174     [ t ] [
 175         "a" <pathname> \ + usage member?
 176     ] unit-test
 177
 178     [ ] [
 179         "IN: parser.tests USE: math 2 2 -" <string-reader> "a"
 180         parse-stream drop
 181     ] unit-test
 182
 183     [ f ] [
 184         "a" <pathname> \ + usage member?
 185     ] unit-test
 186
 187     [ ] [
 188         "a" source-files get delete-at
 189         2 [
 190             "IN: parser.tests DEFER: x : y x ; : x y ;"
 191             <string-reader> "a" parse-stream drop
 192         ] times
 193     ] unit-test
 194
 195     "a" source-files get delete-at
 196
 197     [
 198         "IN: parser.tests : x ; : y 3 throw ; this is an error"
 199         <string-reader> "a" parse-stream
 200     ] [ source-file-error? ] must-fail-with
 201
 202     [ t ] [
 203         "y" "parser.tests" lookup >boolean
 204     ] unit-test
 205
 206     [ f ] [
 207         "IN: parser.tests : x ;"
 208         <string-reader> "a" parse-stream drop
 209
 210         "y" "parser.tests" lookup
 211     ] unit-test
 212
 213     ! Test new forward definition logic
 214     [ ] [
 215         "IN: axx : axx ;"
 216         <string-reader> "axx" parse-stream drop
 217     ] unit-test
 218
 219     [ ] [
 220         "USE: axx IN: bxx : bxx ; : cxx axx bxx ;"
 221         <string-reader> "bxx" parse-stream drop
 222     ] unit-test
 223
 224     ! So we move the bxx word to axx...
 225     [ ] [
 226         "IN: axx : axx ; : bxx ;"
 227         <string-reader> "axx" parse-stream drop
 228     ] unit-test
 229
 230     [ t ] [ "bxx" "axx" lookup >boolean ] unit-test
 231
 232     ! And reload the file that uses it...
 233     [ ] [
 234         "USE: axx IN: bxx : cxx axx bxx ;"
 235         <string-reader> "bxx" parse-stream drop
 236     ] unit-test
 237
 238     ! And hope not to get a forward-error!
 239
 240     ! Turning a generic into a non-generic could cause all
 241     ! kinds of funnyness
 242     [ ] [
 243         "IN: ayy USE: kernel GENERIC: ayy M: object ayy ;"
 244         <string-reader> "ayy" parse-stream drop
 245     ] unit-test
 246
 247     [ ] [
 248         "IN: ayy USE: kernel : ayy ;"
 249         <string-reader> "ayy" parse-stream drop
 250     ] unit-test
 251
 252     [ ] [
 253         "IN: azz TUPLE: my-class ; GENERIC: a-generic"
 254         <string-reader> "azz" parse-stream drop
 255     ] unit-test
 256
 257     [ ] [
 258         "USE: azz M: my-class a-generic ;"
 259         <string-reader> "azz-2" parse-stream drop
 260     ] unit-test
 261
 262     [ ] [
 263         "IN: azz GENERIC: a-generic"
 264         <string-reader> "azz" parse-stream drop
 265     ] unit-test
 266
 267     [ ] [
 268         "USE: azz USE: math M: integer a-generic ;"
 269         <string-reader> "azz-2" parse-stream drop
 270     ] unit-test
 271
 272     [ ] [
 273         "IN: parser.tests : <bogus-error> ; : bogus <bogus-error> ;"
 274         <string-reader> "bogus-error" parse-stream drop
 275     ] unit-test
 276
 277     [ ] [
 278         "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus <bogus-error> ;"
 279         <string-reader> "bogus-error" parse-stream drop
 280     ] unit-test
 281
 282     ! Problems with class predicates -vs- ordinary words
 283     [ ] [
 284         "IN: parser.tests TUPLE: killer ;"
 285         <string-reader> "removing-the-predicate" parse-stream drop
 286     ] unit-test
 287
 288     [ ] [
 289         "IN: parser.tests GENERIC: killer? ( a -- b )"
 290         <string-reader> "removing-the-predicate" parse-stream drop
 291     ] unit-test
 292
 293     [ t ] [
 294         "killer?" "parser.tests" lookup >boolean
 295     ] unit-test
 296
 297     [
 298         "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test?"
 299         <string-reader> "removing-the-predicate" parse-stream
 300     ] [ error>> error>> error>> redefine-error? ] must-fail-with
 301
 302     [
 303         "IN: parser.tests TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
 304         <string-reader> "redefining-a-class-1" parse-stream
 305     ] [ error>> error>> error>> redefine-error? ] must-fail-with
 306
 307     [ ] [
 308         "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
 309         <string-reader> "redefining-a-class-2" parse-stream drop
 310     ] unit-test
 311
 312     [
 313         "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;"
 314         <string-reader> "redefining-a-class-3" parse-stream drop
 315     ] [ error>> error>> error>> redefine-error? ] must-fail-with
 316
 317     [ ] [
 318         "IN: parser.tests TUPLE: class-fwd-test ;"
 319         <string-reader> "redefining-a-class-3" parse-stream drop
 320     ] unit-test
 321
 322     [
 323         "IN: parser.tests \\ class-fwd-test"
 324         <string-reader> "redefining-a-class-3" parse-stream drop
 325     ] [ error>> error>> error>> no-word-error? ] must-fail-with
 326
 327     [ ] [
 328         "IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
 329         <string-reader> "redefining-a-class-3" parse-stream drop
 330     ] unit-test
 331
 332     [
 333         "IN: parser.tests \\ class-fwd-test"
 334         <string-reader> "redefining-a-class-3" parse-stream drop
 335     ] [ error>> error>> error>> no-word-error? ] must-fail-with
 336
 337     [
 338         "IN: parser.tests : foo ; TUPLE: foo ;"
 339         <string-reader> "redefining-a-class-4" parse-stream drop
 340     ] [ error>> error>> error>> redefine-error? ] must-fail-with
 341
 342     [ ] [
 343         "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval
 344     ] unit-test
 345
 346     [
 347         "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval
 348     ] must-fail
 349 ] with-file-vocabs
 350
 351 [ ] [
 352     "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval
 353 ] unit-test
 354
 355 [ t ] [
 356     "foo?" "parser.tests" lookup word eq?
 357 ] unit-test
 358
 359 [ ] [
 360     [
 361         "redefining-a-class-5" forget-source
 362         "redefining-a-class-6" forget-source
 363         "redefining-a-class-7" forget-source
 364     ] with-compilation-unit
 365 ] unit-test
 366
 367 2 [
 368     [ ] [
 369         "IN: parser.tests TUPLE: foo ; GENERIC: foo"
 370         <string-reader> "redefining-a-class-5" parse-stream drop
 371     ] unit-test
 372
 373     [ ] [
 374         "IN: parser.tests M: f foo ;"
 375         <string-reader> "redefining-a-class-6" parse-stream drop
 376     ] unit-test
 377
 378     [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
 379
 380     [ ] [
 381         "IN: parser.tests TUPLE: foo ; GENERIC: foo"
 382         <string-reader> "redefining-a-class-5" parse-stream drop
 383     ] unit-test
 384
 385     [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
 386
 387     [ ] [
 388         "IN: parser.tests TUPLE: foo ; GENERIC: foo"
 389     <string-reader> "redefining-a-class-7" parse-stream drop
 390     ] unit-test
 391
 392     [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
 393
 394     [ ] [
 395         "IN: parser.tests TUPLE: foo ;"
 396         <string-reader> "redefining-a-class-7" parse-stream drop
 397     ] unit-test
 398
 399     [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
 400 ] times
 401
 402 [ "resource:core/parser/test/assert-depth.factor" run-file ]
 403 [ stack>> { 1 2 3 } sequence= ]
 404 must-fail-with
 405
 406 2 [
 407     [ ] [
 408         "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
 409         <string-reader> "d-f-s-test" parse-stream drop
 410     ] unit-test
 411
 412     [ ] [
 413         "IN: parser.tests DEFER: d-f-s d-f-s FORGET: d-f-s SYMBOL: d-f-s d-f-s"
 414         <string-reader> "d-f-s-test" parse-stream drop
 415     ] unit-test
 416
 417     [ ] [
 418         "IN: parser.tests DEFER: d-f-s d-f-s SYMBOL: d-f-s d-f-s"
 419         <string-reader> "d-f-s-test" parse-stream drop
 420     ] unit-test
 421 ] times
 422
 423 [ ] [
 424     [ "this-better-not-exist" forget-vocab ] with-compilation-unit
 425 ] unit-test
 426
 427 [
 428     "USE: this-better-not-exist" eval
 429 ] must-fail
 430
 431 [ ": foo ;" eval ] [ error>> no-current-vocab? ] must-fail-with
 432
 433 [ 92 ] [ "CHAR: \\" eval ] unit-test
 434 [ 92 ] [ "CHAR: \\\\" eval ] unit-test
 435
 436 [ ] [
 437     {
 438         "IN: parser.tests"
 439         "USING: math arrays ;"
 440         "GENERIC: change-combination"
 441         "M: integer change-combination 1 ;"
 442         "M: array change-combination 2 ;"
 443     } "\n" join <string-reader> "change-combination-test" parse-stream drop
 444 ] unit-test
 445
 446 [ ] [
 447     {
 448         "IN: parser.tests"
 449         "USING: math arrays ;"
 450         "GENERIC# change-combination 1"
 451         "M: integer change-combination 1 ;"
 452         "M: array change-combination 2 ;"
 453     } "\n" join <string-reader> "change-combination-test" parse-stream drop
 454 ] unit-test
 455
 456 [ 2 ] [
 457     "change-combination" "parser.tests" lookup
 458     "methods" word-prop assoc-size
 459 ] unit-test
 460
 461 [ ] [
 462     2 [
 463         "IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
 464         <string-reader> "twice-fails-test" parse-stream drop
 465     ] times
 466 ] unit-test
 467
 468 [ [ ] ] [
 469     "IN: parser.tests : staging-problem-test-1 1 ; : staging-problem-test-2 staging-problem-test-1 ;"
 470     <string-reader> "staging-problem-test" parse-stream
 471 ] unit-test
 472
 473 [ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
 474
 475 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
 476
 477 [ [ ] ] [
 478     "IN: parser.tests << : staging-problem-test-1 1 ; >> : staging-problem-test-2 staging-problem-test-1 ;"
 479     <string-reader> "staging-problem-test" parse-stream
 480 ] unit-test
 481
 482 [ t ] [ "staging-problem-test-1" "parser.tests" lookup >boolean ] unit-test
 483
 484 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
 485
 486 [ "DEFER: blah" eval ] [ error>> no-current-vocab? ] must-fail-with
 487
 488 [
 489     "IN: parser.tests : blah ; parsing FORGET: blah" eval
 490 ] [
 491     error>> staging-violation?
 492 ] must-fail-with