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 tuples ;
   5 IN: temporary
   6
   7 [
   8     file-vocabs
   9
  10     [ 1 CHAR: a ]
  11     [ 0 "abcd" next-char ] unit-test
  12
  13     [ 6 CHAR: \s ]
  14     [ 1 "\\u0020hello" next-escape ] unit-test
  15
  16     [ 2 CHAR: \n ]
  17     [ 1 "\\nhello" next-escape ] unit-test
  18
  19     [ 6 CHAR: \s ]
  20     [ 0 "\\u0020hello" next-char ] unit-test
  21
  22     [ [ 1 [ 2 [ 3 ] 4 ] 5 ] ]
  23     [ "1\n[\n2\n[\n3\n]\n4\n]\n5" parse ]
  24     unit-test
  25
  26     [ [ t t f f ] ]
  27     [ "t t f f" parse ]
  28     unit-test
  29
  30     [ [ "hello world" ] ]
  31     [ "\"hello world\"" parse ]
  32     unit-test
  33
  34     [ [ "\n\r\t\\" ] ]
  35     [ "\"\\n\\r\\t\\\\\"" parse ]
  36     unit-test
  37
  38     [ "hello world" ]
  39     [
  40         "IN: temporary : hello \"hello world\" ;"
  41         parse call "USE: scratchpad hello" eval
  42     ] unit-test
  43
  44     [ ]
  45     [ "! This is a comment, people." parse call ]
  46     unit-test
  47
  48     ! Test escapes
  49
  50     [ [ " " ] ]
  51     [ "\"\\u0020\"" parse ]
  52     unit-test
  53
  54     [ [ "'" ] ]
  55     [ "\"\\u0027\"" parse ]
  56     unit-test
  57
  58     [ "\\u123" parse ] unit-test-fails
  59
  60     ! Test EOL comments in multiline strings.
  61     [ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test
  62
  63     [ word ] [ \ f class ] unit-test
  64
  65     ! Test stack effect parsing
  66
  67     : effect-parsing-test ( a b -- c ) + ;
  68
  69     [ t ] [
  70         "effect-parsing-test" "temporary" lookup
  71         \ effect-parsing-test eq?
  72     ] unit-test
  73
  74     [ T{ effect f { "a" "b" } { "c" } f } ]
  75     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  76
  77     : baz ( a b -- * ) 2array throw ;
  78
  79     [ t ]
  80     [ \ baz "declared-effect" word-prop effect-terminated? ]
  81     unit-test
  82
  83     [ [ ] ] [ "IN: temporary USE: math : effect-parsing-test ( a b -- d ) - ;" parse ] unit-test
  84
  85     [ t ] [
  86         "effect-parsing-test" "temporary" lookup
  87         \ effect-parsing-test eq?
  88     ] unit-test
  89
  90     [ T{ effect f { "a" "b" } { "d" } f } ]
  91     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  92
  93     [ [ ] ] [ "IN: temporary : effect-parsing-test ;" parse ] unit-test
  94
  95     [ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
  96
  97     ! Funny bug
  98     [ 2 ] [ "IN: temporary : \0. 2 ; \0." eval ] unit-test
  99
 100     [ "IN: temporary : missing-- ( a b ) ;" eval ] unit-test-fails
 101
 102     ! These should throw errors
 103     [ "HEX: zzz" parse ] unit-test-fails
 104     [ "OCT: 999" parse ] unit-test-fails
 105     [ "BIN: --0" parse ] unit-test-fails
 106
 107     [ f ] [
 108         "IN: temporary : foo ; TUPLE: foo ;" parse drop
 109         "foo" "temporary" lookup symbol?
 110     ] unit-test
 111
 112     ! Another funny bug
 113     [ t ] [
 114         [
 115             "scratchpad" in set
 116             { "scratchpad" "arrays" } set-use
 117             [
 118                 ! This shouldn't modify in/use in the outer scope!
 119                 file-vocabs
 120             ] with-scope
 121
 122             use get { "scratchpad" "arrays" } set-use use get =
 123         ] with-scope
 124     ] unit-test
 125     DEFER: foo
 126
 127     "IN: temporary USING: math prettyprint ; : foo 2 2 + . ; parsing" eval
 128
 129     [ [ ] ] [ "USE: temporary foo" parse ] unit-test
 130
 131     "IN: temporary USING: math prettyprint ; : foo 2 2 + . ;" eval
 132
 133     [ t ] [
 134         "USE: temporary foo" parse
 135         first "foo" "temporary" lookup eq?
 136     ] unit-test
 137
 138     ! Test smudging
 139
 140     [ 1 ] [
 141         "IN: temporary : smudge-me ;" <string-reader> "foo"
 142         parse-stream drop
 143
 144         "foo" source-file source-file-definitions assoc-size
 145     ] unit-test
 146
 147     [ t ] [ "smudge-me" "temporary" lookup >boolean ] unit-test
 148
 149     [ ] [
 150         "IN: temporary : smudge-me-more ;" <string-reader> "foo"
 151         parse-stream drop
 152     ] unit-test
 153
 154     [ t ] [ "smudge-me-more" "temporary" lookup >boolean ] unit-test
 155     [ f ] [ "smudge-me" "temporary" lookup >boolean ] unit-test
 156
 157     [ 3 ] [
 158         "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
 159         parse-stream drop
 160
 161         "foo" source-file source-file-definitions assoc-size
 162     ] unit-test
 163
 164     [ 1 ] [
 165         "IN: temporary USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
 166         parse-stream drop
 167
 168         "bar" source-file source-file-definitions assoc-size
 169     ] unit-test
 170
 171     [ 2 ] [
 172         "IN: temporary USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" <string-reader> "foo"
 173         parse-stream drop
 174
 175         "foo" source-file source-file-definitions assoc-size
 176     ] unit-test
 177
 178     [ t ] [
 179         array "smudge-me" "temporary" lookup order memq?
 180     ] unit-test
 181
 182     [ t ] [
 183         integer "smudge-me" "temporary" lookup order memq?
 184     ] unit-test
 185
 186     [ f ] [
 187         string "smudge-me" "temporary" lookup order memq?
 188     ] unit-test
 189
 190     [ ] [
 191         "IN: temporary USE: math 2 2 +" <string-reader> "a"
 192         parse-stream drop
 193     ] unit-test
 194
 195     [ t ] [
 196         "a" <pathname> \ + usage member?
 197     ] unit-test
 198
 199     [ ] [
 200         "IN: temporary USE: math 2 2 -" <string-reader> "a"
 201         parse-stream drop
 202     ] unit-test
 203
 204     [ f ] [
 205         "a" <pathname> \ + usage member?
 206     ] unit-test
 207
 208     [ ] [
 209         "a" source-files get delete-at
 210         2 [
 211             "IN: temporary DEFER: x : y x ; : x y ;"
 212             <string-reader> "a" parse-stream drop
 213         ] times
 214     ] unit-test
 215
 216     "a" source-files get delete-at
 217
 218     [ t ] [
 219         [
 220             "IN: temporary : x ; : y 3 throw ; parsing y"
 221             <string-reader> "a" parse-stream
 222         ] catch parse-error?
 223     ] unit-test
 224
 225     [ t ] [
 226         "y" "temporary" lookup >boolean
 227     ] unit-test
 228
 229     [ f ] [
 230         "IN: temporary : x ;"
 231         <string-reader> "a" parse-stream drop
 232
 233         "y" "temporary" lookup
 234     ] unit-test
 235
 236     ! Test new forward definition logic
 237     [ ] [
 238         "IN: axx : axx ;"
 239         <string-reader> "axx" parse-stream drop
 240     ] unit-test
 241
 242     [ ] [
 243         "USE: axx IN: bxx : bxx ; : cxx axx bxx ;"
 244         <string-reader> "bxx" parse-stream drop
 245     ] unit-test
 246
 247     ! So we move the bxx word to axx...
 248     [ ] [
 249         "IN: axx : axx ; : bxx ;"
 250         <string-reader> "axx" parse-stream drop
 251     ] unit-test
 252
 253     [ t ] [ "bxx" "axx" lookup >boolean ] unit-test
 254
 255     ! And reload the file that uses it...
 256     [ ] [
 257         "USE: axx IN: bxx : cxx axx bxx ;"
 258         <string-reader> "bxx" parse-stream drop
 259     ] unit-test
 260
 261     ! And hope not to get a forward-error!
 262
 263     ! Turning a generic into a non-generic could cause all
 264     ! kinds of funnyness
 265     [ ] [
 266         "IN: ayy USE: kernel GENERIC: ayy M: object ayy ;"
 267         <string-reader> "ayy" parse-stream drop
 268     ] unit-test
 269
 270     [ ] [
 271         "IN: ayy USE: kernel : ayy ;"
 272         <string-reader> "ayy" parse-stream drop
 273     ] unit-test
 274
 275     [ ] [
 276         "IN: azz TUPLE: my-class ; GENERIC: a-generic"
 277         <string-reader> "azz" parse-stream drop
 278     ] unit-test
 279
 280     [ ] [
 281         "USE: azz M: my-class a-generic ;"
 282         <string-reader> "azz-2" parse-stream drop
 283     ] unit-test
 284
 285     [ ] [
 286         "IN: azz GENERIC: a-generic"
 287         <string-reader> "azz" parse-stream drop
 288     ] unit-test
 289
 290     [ ] [
 291         "USE: azz USE: math M: integer a-generic ;"
 292         <string-reader> "azz-2" parse-stream drop
 293     ] unit-test
 294
 295     [ ] [
 296         "IN: temporary : <bogus-error> ; : bogus <bogus-error> ;"
 297         <string-reader> "bogus-error" parse-stream drop
 298     ] unit-test
 299
 300     [ ] [
 301         "IN: temporary TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus <bogus-error> ;"
 302         <string-reader> "bogus-error" parse-stream drop
 303     ] unit-test
 304
 305     ! Problems with class predicates -vs- ordinary words
 306     [ ] [
 307         "IN: temporary TUPLE: killer ;"
 308         <string-reader> "removing-the-predicate" parse-stream drop
 309     ] unit-test
 310
 311     [ ] [
 312         "IN: temporary GENERIC: killer?"
 313         <string-reader> "removing-the-predicate" parse-stream drop
 314     ] unit-test
 315
 316     [ t ] [
 317         "killer?" "temporary" lookup >boolean
 318     ] unit-test
 319
 320     [ t ] [
 321         [
 322             "IN: temporary TUPLE: another-pred-test ; GENERIC: another-pred-test?"
 323             <string-reader> "removing-the-predicate" parse-stream
 324         ] catch [ redefine-error? ] is?
 325     ] unit-test
 326 ] with-scope
 327
 328 [
 329     : FILE file get parsed ; parsing
 330
 331     FILE file set
 332
 333     : ~a ;
 334     : ~b ~a ;
 335     : ~c ;
 336     : ~d ;
 337
 338     H{ { ~a ~a } { ~c ~c } { ~d ~d } } old-definitions set
 339
 340     H{ { ~d ~d } } new-definitions set
 341
 342     [ V{ ~b } { ~a } { ~a ~c } ] [
 343         smudged-usage
 344         natural-sort
 345     ] unit-test
 346 ] with-scope