giles
8daf33dc53
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
86 lines
2.5 KiB
Plaintext
86 lines
2.5 KiB
Plaintext
;; Classic programs corpus tests.
|
|
;;
|
|
;; Each program lives in tests/programs/*.st as canonical Smalltalk source.
|
|
;; This file embeds the same source as a string (until a file-read primitive
|
|
;; lands) and runs it via smalltalk-load, then asserts behaviour.
|
|
|
|
(set! st-test-pass 0)
|
|
(set! st-test-fail 0)
|
|
(set! st-test-fails (list))
|
|
|
|
(define ev (fn (src) (smalltalk-eval src)))
|
|
(define evp (fn (src) (smalltalk-eval-program src)))
|
|
|
|
;; ── fibonacci.st (kept in sync with lib/smalltalk/tests/programs/fibonacci.st) ──
|
|
(define
|
|
fib-source
|
|
"Object subclass: #Fibonacci
|
|
instanceVariableNames: 'memo'!
|
|
|
|
!Fibonacci methodsFor: 'init'!
|
|
init memo := Array new: 100. ^ self! !
|
|
|
|
!Fibonacci methodsFor: 'compute'!
|
|
fib: n
|
|
n < 2 ifTrue: [^ n].
|
|
^ (self fib: n - 1) + (self fib: n - 2)!
|
|
|
|
memoFib: n
|
|
| cached |
|
|
cached := memo at: n + 1.
|
|
cached notNil ifTrue: [^ cached].
|
|
cached := n < 2
|
|
ifTrue: [n]
|
|
ifFalse: [(self memoFib: n - 1) + (self memoFib: n - 2)].
|
|
memo at: n + 1 put: cached.
|
|
^ cached! !")
|
|
|
|
(st-bootstrap-classes!)
|
|
(smalltalk-load fib-source)
|
|
|
|
(st-test "fib(0)" (evp "^ Fibonacci new fib: 0") 0)
|
|
(st-test "fib(1)" (evp "^ Fibonacci new fib: 1") 1)
|
|
(st-test "fib(2)" (evp "^ Fibonacci new fib: 2") 1)
|
|
(st-test "fib(5)" (evp "^ Fibonacci new fib: 5") 5)
|
|
(st-test "fib(10)" (evp "^ Fibonacci new fib: 10") 55)
|
|
(st-test "fib(15)" (evp "^ Fibonacci new fib: 15") 610)
|
|
|
|
(st-test "memoFib(20)"
|
|
(evp "| f | f := Fibonacci new init. ^ f memoFib: 20")
|
|
6765)
|
|
|
|
(st-test "memoFib(30)"
|
|
(evp "| f | f := Fibonacci new init. ^ f memoFib: 30")
|
|
832040)
|
|
|
|
;; Memoisation actually populates the array.
|
|
(st-test "memo cache stores intermediate"
|
|
(evp
|
|
"| f | f := Fibonacci new init.
|
|
f memoFib: 12.
|
|
^ #(0 1 1 2 3 5) , #() , #()")
|
|
(list 0 1 1 2 3 5))
|
|
|
|
;; The class is reachable from the bootstrap class table.
|
|
(st-test "Fibonacci class exists in table" (st-class-exists? "Fibonacci") true)
|
|
(st-test "Fibonacci has memo ivar"
|
|
(get (st-class-get "Fibonacci") :ivars)
|
|
(list "memo"))
|
|
|
|
;; Method dictionary holds the three methods.
|
|
(st-test "Fibonacci methodDict size"
|
|
(len (keys (get (st-class-get "Fibonacci") :methods)))
|
|
3)
|
|
|
|
;; Each fib call is independent (no shared state between two instances).
|
|
(st-test "two memo instances independent"
|
|
(evp
|
|
"| a b |
|
|
a := Fibonacci new init.
|
|
b := Fibonacci new init.
|
|
a memoFib: 10.
|
|
^ b memoFib: 10")
|
|
55)
|
|
|
|
(list st-test-pass st-test-fail)
|