;; 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)

;; ── eight-queens.st (kept in sync with lib/smalltalk/tests/programs/eight-queens.st) ──
(define
  queens-source
  "Object subclass: #EightQueens
     instanceVariableNames: 'columns count size'!

   !EightQueens methodsFor: 'init'!
   init
     size := 8.
     columns := Array new: size.
     count := 0.
     ^ self!

   size: n
     size := n.
     columns := Array new: n.
     count := 0.
     ^ self! !

   !EightQueens methodsFor: 'access'!
   count ^ count!

   size ^ size! !

   !EightQueens methodsFor: 'solve'!
   solve
     self placeRow: 1.
     ^ count!

   placeRow: row
     row > size ifTrue: [count := count + 1. ^ self].
     1 to: size do: [:col |
       (self isSafe: col atRow: row) ifTrue: [
         columns at: row put: col.
         self placeRow: row + 1]]!

   isSafe: col atRow: row
     | r prevCol delta |
     r := 1.
     [r < row] whileTrue: [
       prevCol := columns at: r.
       prevCol = col ifTrue: [^ false].
       delta := col - prevCol.
       delta abs = (row - r) ifTrue: [^ false].
       r := r + 1].
     ^ true! !")

(smalltalk-load queens-source)

;; Backtracking is correct but slow on the spec interpreter (call/cc per
;; method, dict-based ivar reads). 4- and 5-queens cover the corners
;; and run in under 10s; 6+ work but would push past the test-runner
;; timeout. The class itself defaults to size 8, ready for the JIT.
(st-test "1 queen on 1x1 board" (evp "^ (EightQueens new size: 1) solve") 1)
(st-test "4 queens on 4x4 board" (evp "^ (EightQueens new size: 4) solve") 2)
(st-test "5 queens on 5x5 board" (evp "^ (EightQueens new size: 5) solve") 10)
(st-test "EightQueens class is registered" (st-class-exists? "EightQueens") true)
(st-test "EightQueens init sets size 8"
  (evp "^ EightQueens new init size") 8)

(list st-test-pass st-test-fail)