giles
75032c5789
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
93 lines
3.5 KiB
Plaintext
93 lines
3.5 KiB
Plaintext
;; Block-intrinsifier tests.
|
|
;;
|
|
;; AST-level recognition of `ifTrue:`, `ifFalse:`, `ifTrue:ifFalse:`,
|
|
;; `ifFalse:ifTrue:`, `whileTrue:`, `whileFalse:`, `and:`, `or:`
|
|
;; short-circuits dispatch when the block argument is simple
|
|
;; (no params, no temps).
|
|
|
|
(set! st-test-pass 0)
|
|
(set! st-test-fail 0)
|
|
(set! st-test-fails (list))
|
|
|
|
(st-bootstrap-classes!)
|
|
(define ev (fn (src) (smalltalk-eval src)))
|
|
(define evp (fn (src) (smalltalk-eval-program src)))
|
|
|
|
;; ── 1. Each intrinsic increments the hit counter ──
|
|
(st-intrinsic-reset!)
|
|
|
|
(ev "true ifTrue: [1]")
|
|
(st-test "ifTrue: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(ev "false ifFalse: [2]")
|
|
(st-test "ifFalse: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(ev "true ifTrue: [1] ifFalse: [2]")
|
|
(st-test "ifTrue:ifFalse: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(ev "false ifFalse: [1] ifTrue: [2]")
|
|
(st-test "ifFalse:ifTrue: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(ev "true and: [42]")
|
|
(st-test "and: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(ev "false or: [99]")
|
|
(st-test "or: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(evp "| n | n := 5. [n > 0] whileTrue: [n := n - 1]. ^ n")
|
|
(st-test "whileTrue: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
(st-intrinsic-reset!)
|
|
(evp "| n | n := 0. [n >= 3] whileFalse: [n := n + 1]. ^ n")
|
|
(st-test "whileFalse: hit" (>= (get (st-intrinsic-stats) :hits) 1) true)
|
|
|
|
;; ── 2. Intrinsified results match the dispatched ones ──
|
|
(st-test "ifTrue: with true branch" (ev "true ifTrue: [42]") 42)
|
|
(st-test "ifTrue: with false branch" (ev "false ifTrue: [42]") nil)
|
|
(st-test "ifFalse: with false branch"(ev "false ifFalse: [42]") 42)
|
|
(st-test "ifFalse: with true branch" (ev "true ifFalse: [42]") nil)
|
|
(st-test "ifTrue:ifFalse: t" (ev "true ifTrue: [1] ifFalse: [2]") 1)
|
|
(st-test "ifTrue:ifFalse: f" (ev "false ifTrue: [1] ifFalse: [2]") 2)
|
|
(st-test "ifFalse:ifTrue: t" (ev "true ifFalse: [1] ifTrue: [2]") 2)
|
|
(st-test "ifFalse:ifTrue: f" (ev "false ifFalse: [1] ifTrue: [2]") 1)
|
|
(st-test "and: short-circuits" (ev "false and: [1/0]") false)
|
|
(st-test "or: short-circuits" (ev "true or: [1/0]") true)
|
|
|
|
(st-test "whileTrue: completes counting"
|
|
(evp "| n | n := 5. [n > 0] whileTrue: [n := n - 1]. ^ n") 0)
|
|
(st-test "whileFalse: completes counting"
|
|
(evp "| n | n := 0. [n >= 3] whileFalse: [n := n + 1]. ^ n") 3)
|
|
|
|
;; ── 3. Blocks with params or temps fall through to dispatch ──
|
|
(st-intrinsic-reset!)
|
|
(ev "true ifTrue: [| t | t := 1. t]")
|
|
(st-test "block-with-temps falls through (no intrinsic hit)"
|
|
(get (st-intrinsic-stats) :hits) 0)
|
|
|
|
;; ── 4. ^ inside an intrinsified block still escapes the method ──
|
|
(st-class-define! "EarlyOut" "Object" (list))
|
|
(st-class-add-method! "EarlyOut" "search:in:"
|
|
(st-parse-method
|
|
"search: target in: arr
|
|
arr do: [:e | e = target ifTrue: [^ e]].
|
|
^ nil"))
|
|
|
|
(st-test "^ from intrinsified ifTrue: still returns from method"
|
|
(evp "^ EarlyOut new search: 3 in: #(1 2 3 4 5)") 3)
|
|
(st-test "^ falls through when no match"
|
|
(evp "^ EarlyOut new search: 99 in: #(1 2 3)") nil)
|
|
|
|
;; ── 5. Intrinsics don't break under repeated invocation ──
|
|
(st-intrinsic-reset!)
|
|
(evp "| n | n := 0. 1 to: 100 do: [:i | n := n + 1]. ^ n")
|
|
(st-test "intrinsified to:do: ran (counter reflects ifTrue:s inside)"
|
|
(>= (get (st-intrinsic-stats) :hits) 0) true)
|
|
|
|
(list st-test-pass st-test-fail)
|