Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
295 lines
8.6 KiB
Plaintext
295 lines
8.6 KiB
Plaintext
;; 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)
|