smalltalk: chunk-stream parser + pragmas + 21 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
294
lib/smalltalk/tests/parse_chunks.sx
Normal file
294
lib/smalltalk/tests/parse_chunks.sx
Normal file
@@ -0,0 +1,294 @@
|
||||
;; Smalltalk chunk-stream parser + pragma tests.
|
||||
;;
|
||||
;; Reuses helpers (st-test, st-deep=?) from tokenize.sx. Counters reset
|
||||
;; here so this file's summary covers chunk + pragma tests only.
|
||||
|
||||
(set! st-test-pass 0)
|
||||
(set! st-test-fail 0)
|
||||
(set! st-test-fails (list))
|
||||
|
||||
;; ── 1. Raw chunk reader ──
|
||||
(st-test "empty source" (st-read-chunks "") (list))
|
||||
(st-test "single chunk" (st-read-chunks "foo!") (list "foo"))
|
||||
(st-test "two chunks" (st-read-chunks "a! b!") (list "a" "b"))
|
||||
(st-test "trailing no bang" (st-read-chunks "a! b") (list "a" "b"))
|
||||
(st-test "empty chunk" (st-read-chunks "a! ! b!") (list "a" "" "b"))
|
||||
(st-test
|
||||
"doubled bang escapes"
|
||||
(st-read-chunks "yes!! no!yes!")
|
||||
(list "yes! no" "yes"))
|
||||
(st-test
|
||||
"whitespace trimmed"
|
||||
(st-read-chunks " \n hello \n !")
|
||||
(list "hello"))
|
||||
|
||||
;; ── 2. Chunk parser — do-it mode ──
|
||||
(st-test
|
||||
"single do-it chunk"
|
||||
(st-parse-chunks "1 + 2!")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "lit-int" :value 1}
|
||||
:selector "+"
|
||||
:args (list {:type "lit-int" :value 2})}}))
|
||||
|
||||
(st-test
|
||||
"two do-it chunks"
|
||||
(st-parse-chunks "x := 1! y := 2!")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "assign" :name "x" :expr {:type "lit-int" :value 1}}}
|
||||
{:kind "expr"
|
||||
:ast {:type "assign" :name "y" :expr {:type "lit-int" :value 2}}}))
|
||||
|
||||
(st-test
|
||||
"blank chunk outside methods"
|
||||
(st-parse-chunks "1! ! 2!")
|
||||
(list
|
||||
{:kind "expr" :ast {:type "lit-int" :value 1}}
|
||||
{:kind "blank"}
|
||||
{:kind "expr" :ast {:type "lit-int" :value 2}}))
|
||||
|
||||
;; ── 3. Methods batch ──
|
||||
(st-test
|
||||
"methodsFor opens method batch"
|
||||
(st-parse-chunks
|
||||
"Foo methodsFor: 'access'! foo ^ 1! bar ^ 2! !")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "ident" :name "Foo"}
|
||||
:selector "methodsFor:"
|
||||
:args (list {:type "lit-string" :value "access"})}}
|
||||
{:kind "method"
|
||||
:class "Foo"
|
||||
:class-side? false
|
||||
:category "access"
|
||||
:ast {:type "method"
|
||||
:selector "foo"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "return" :expr {:type "lit-int" :value 1}})}}
|
||||
{:kind "method"
|
||||
:class "Foo"
|
||||
:class-side? false
|
||||
:category "access"
|
||||
:ast {:type "method"
|
||||
:selector "bar"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "return" :expr {:type "lit-int" :value 2}})}}
|
||||
{:kind "end-methods"}))
|
||||
|
||||
(st-test
|
||||
"class-side methodsFor"
|
||||
(st-parse-chunks
|
||||
"Foo class methodsFor: 'creation'! make ^ self new! !")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "send"
|
||||
:receiver {:type "ident" :name "Foo"}
|
||||
:selector "class"
|
||||
:args (list)}
|
||||
:selector "methodsFor:"
|
||||
:args (list {:type "lit-string" :value "creation"})}}
|
||||
{:kind "method"
|
||||
:class "Foo"
|
||||
:class-side? true
|
||||
:category "creation"
|
||||
:ast {:type "method"
|
||||
:selector "make"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "return"
|
||||
:expr {:type "send"
|
||||
:receiver {:type "self"}
|
||||
:selector "new"
|
||||
:args (list)}})}}
|
||||
{:kind "end-methods"}))
|
||||
|
||||
(st-test
|
||||
"method batch returns to do-it after empty chunk"
|
||||
(st-parse-chunks
|
||||
"Foo methodsFor: 'a'! m1 ^ 1! ! 99!")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "ident" :name "Foo"}
|
||||
:selector "methodsFor:"
|
||||
:args (list {:type "lit-string" :value "a"})}}
|
||||
{:kind "method"
|
||||
:class "Foo"
|
||||
:class-side? false
|
||||
:category "a"
|
||||
:ast {:type "method"
|
||||
:selector "m1"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "return" :expr {:type "lit-int" :value 1}})}}
|
||||
{:kind "end-methods"}
|
||||
{:kind "expr" :ast {:type "lit-int" :value 99}}))
|
||||
|
||||
;; ── 4. Pragmas in method bodies ──
|
||||
(st-test
|
||||
"single pragma"
|
||||
(st-parse-method "primAt: i <primitive: 60> ^ self")
|
||||
{:type "method"
|
||||
:selector "primAt:"
|
||||
:params (list "i")
|
||||
:temps (list)
|
||||
:pragmas (list
|
||||
{:selector "primitive:"
|
||||
:args (list {:type "lit-int" :value 60})})
|
||||
:body (list {:type "return" :expr {:type "self"}})})
|
||||
|
||||
(st-test
|
||||
"pragma with two keyword pairs"
|
||||
(st-parse-method "fft <primitive: 1 module: 'fft'> ^ nil")
|
||||
{:type "method"
|
||||
:selector "fft"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list
|
||||
{:selector "primitive:module:"
|
||||
:args (list
|
||||
{:type "lit-int" :value 1}
|
||||
{:type "lit-string" :value "fft"})})
|
||||
:body (list {:type "return" :expr {:type "lit-nil"}})})
|
||||
|
||||
(st-test
|
||||
"pragma with negative number"
|
||||
(st-parse-method "neg <primitive: -1> ^ nil")
|
||||
{:type "method"
|
||||
:selector "neg"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list
|
||||
{:selector "primitive:"
|
||||
:args (list {:type "lit-int" :value -1})})
|
||||
:body (list {:type "return" :expr {:type "lit-nil"}})})
|
||||
|
||||
(st-test
|
||||
"pragma with symbol arg"
|
||||
(st-parse-method "tagged <category: #algebra> ^ nil")
|
||||
{:type "method"
|
||||
:selector "tagged"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list
|
||||
{:selector "category:"
|
||||
:args (list {:type "lit-symbol" :value "algebra"})})
|
||||
:body (list {:type "return" :expr {:type "lit-nil"}})})
|
||||
|
||||
(st-test
|
||||
"pragma then temps"
|
||||
(st-parse-method "calc <primitive: 1> | t | t := 5. ^ t")
|
||||
{:type "method"
|
||||
:selector "calc"
|
||||
:params (list)
|
||||
:temps (list "t")
|
||||
:pragmas (list
|
||||
{:selector "primitive:"
|
||||
:args (list {:type "lit-int" :value 1})})
|
||||
:body (list
|
||||
{:type "assign" :name "t" :expr {:type "lit-int" :value 5}}
|
||||
{:type "return" :expr {:type "ident" :name "t"}})})
|
||||
|
||||
(st-test
|
||||
"temps then pragma"
|
||||
(st-parse-method "calc | t | <primitive: 1> t := 5. ^ t")
|
||||
{:type "method"
|
||||
:selector "calc"
|
||||
:params (list)
|
||||
:temps (list "t")
|
||||
:pragmas (list
|
||||
{:selector "primitive:"
|
||||
:args (list {:type "lit-int" :value 1})})
|
||||
:body (list
|
||||
{:type "assign" :name "t" :expr {:type "lit-int" :value 5}}
|
||||
{:type "return" :expr {:type "ident" :name "t"}})})
|
||||
|
||||
(st-test
|
||||
"two pragmas"
|
||||
(st-parse-method "m <primitive: 1> <category: 'a'> ^ self")
|
||||
{:type "method"
|
||||
:selector "m"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list
|
||||
{:selector "primitive:"
|
||||
:args (list {:type "lit-int" :value 1})}
|
||||
{:selector "category:"
|
||||
:args (list {:type "lit-string" :value "a"})})
|
||||
:body (list {:type "return" :expr {:type "self"}})})
|
||||
|
||||
;; ── 5. End-to-end: a small "filed-in" snippet ──
|
||||
(st-test
|
||||
"small filed-in class snippet"
|
||||
(st-parse-chunks
|
||||
"Object subclass: #Account
|
||||
instanceVariableNames: 'balance'!
|
||||
|
||||
!Account methodsFor: 'access'!
|
||||
balance
|
||||
^ balance!
|
||||
|
||||
deposit: amount
|
||||
balance := balance + amount.
|
||||
^ self! !")
|
||||
(list
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "ident" :name "Object"}
|
||||
:selector "subclass:instanceVariableNames:"
|
||||
:args (list
|
||||
{:type "lit-symbol" :value "Account"}
|
||||
{:type "lit-string" :value "balance"})}}
|
||||
{:kind "blank"}
|
||||
{:kind "expr"
|
||||
:ast {:type "send"
|
||||
:receiver {:type "ident" :name "Account"}
|
||||
:selector "methodsFor:"
|
||||
:args (list {:type "lit-string" :value "access"})}}
|
||||
{:kind "method"
|
||||
:class "Account"
|
||||
:class-side? false
|
||||
:category "access"
|
||||
:ast {:type "method"
|
||||
:selector "balance"
|
||||
:params (list)
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "return"
|
||||
:expr {:type "ident" :name "balance"}})}}
|
||||
{:kind "method"
|
||||
:class "Account"
|
||||
:class-side? false
|
||||
:category "access"
|
||||
:ast {:type "method"
|
||||
:selector "deposit:"
|
||||
:params (list "amount")
|
||||
:temps (list)
|
||||
:pragmas (list)
|
||||
:body (list
|
||||
{:type "assign"
|
||||
:name "balance"
|
||||
:expr {:type "send"
|
||||
:receiver {:type "ident" :name "balance"}
|
||||
:selector "+"
|
||||
:args (list {:type "ident" :name "amount"})}}
|
||||
{:type "return" :expr {:type "self"}})}}
|
||||
{:kind "end-methods"}))
|
||||
|
||||
(list st-test-pass st-test-fail)
|
||||
Reference in New Issue
Block a user