rose-ash/lib/smalltalk/tests/sunit.sx

;; SUnit port tests. Loads `lib/smalltalk/sunit.sx` (which itself calls
;; smalltalk-load to install TestCase/TestSuite/TestResult/TestFailure)
;; and exercises the framework on small Smalltalk-defined cases.

(set! st-test-pass 0)
(set! st-test-fail 0)
(set! st-test-fails (list))

;; test.sh loads lib/smalltalk/sunit.sx for us BEFORE this file runs
;; (nested SX loads do not propagate top-level forms reliably, so the
;; bootstrap chain is concentrated in test.sh). The SUnit classes are
;; already present in the class table at this point.

(define ev (fn (src) (smalltalk-eval src)))
(define evp (fn (src) (smalltalk-eval-program src)))

;; ── 1. Classes installed ──
(st-test "TestCase exists"      (st-class-exists? "TestCase")    true)
(st-test "TestSuite exists"     (st-class-exists? "TestSuite")   true)
(st-test "TestResult exists"    (st-class-exists? "TestResult")  true)
(st-test "TestFailure < Error"
  (st-class-inherits-from? "TestFailure" "Error") true)

;; ── 2. A subclass with one passing test runs cleanly ──
(smalltalk-load
  "TestCase subclass: #PassingCase
     instanceVariableNames: ''!

   !PassingCase methodsFor: 'tests'!
   testOnePlusOne self assert: 1 + 1 = 2! !")

(st-test "passing test runs and counts as pass"
  (evp
    "| suite r |
     suite := PassingCase suiteForAll: #(#testOnePlusOne).
     r := suite run.
     ^ r passCount")
  1)

(st-test "passing test has no failures"
  (evp
    "| suite r |
     suite := PassingCase suiteForAll: #(#testOnePlusOne).
     r := suite run.
     ^ r failureCount")
  0)

;; ── 3. A subclass with a failing assert: increments failures ──
(smalltalk-load
  "TestCase subclass: #FailingCase
     instanceVariableNames: ''!

   !FailingCase methodsFor: 'tests'!
   testFalse self assert: false!
   testEquals self assert: 1 + 1 equals: 3! !")

(st-test "assert: false bumps failureCount"
  (evp
    "| suite r |
     suite := FailingCase suiteForAll: #(#testFalse).
     r := suite run.
     ^ r failureCount")
  1)

(st-test "assert:equals: with mismatch fails"
  (evp
    "| suite r |
     suite := FailingCase suiteForAll: #(#testEquals).
     r := suite run.
     ^ r failureCount")
  1)

(st-test "failure messageText captured"
  (evp
    "| suite r rec |
     suite := FailingCase suiteForAll: #(#testEquals).
     r := suite run.
     rec := r failures at: 1.
     ^ rec at: 2")
  "expected 3 but got 2")

;; ── 4. Mixed pass/fail counts add up ──
(smalltalk-load
  "TestCase subclass: #MixedCase
     instanceVariableNames: ''!

   !MixedCase methodsFor: 'tests'!
   testGood self assert: true!
   testBad self assert: false!
   testAlsoGood self assert: 2 > 1! !")

(st-test "mixed suite — totalCount"
  (evp
    "| s r |
     s := MixedCase suiteForAll: #(#testGood #testBad #testAlsoGood).
     r := s run.
     ^ r totalCount")
  3)

(st-test "mixed suite — passCount"
  (evp
    "| s r |
     s := MixedCase suiteForAll: #(#testGood #testBad #testAlsoGood).
     r := s run.
     ^ r passCount")
  2)

(st-test "mixed suite — failureCount"
  (evp
    "| s r |
     s := MixedCase suiteForAll: #(#testGood #testBad #testAlsoGood).
     r := s run.
     ^ r failureCount")
  1)

(st-test "allPassed false on mix"
  (evp
    "| s r |
     s := MixedCase suiteForAll: #(#testGood #testBad #testAlsoGood).
     r := s run.
     ^ r allPassed")
  false)

(st-test "allPassed true with only passes"
  (evp
    "| s r |
     s := MixedCase suiteForAll: #(#testGood #testAlsoGood).
     r := s run.
     ^ r allPassed")
  true)

;; ── 5. setUp / tearDown ──
(smalltalk-load
  "TestCase subclass: #FixtureCase
     instanceVariableNames: 'value'!

   !FixtureCase methodsFor: 'fixture'!
   setUp value := 42. ^ self!
   tearDown ^ self! !

   !FixtureCase methodsFor: 'tests'!
   testValueIs42 self assert: value = 42! !")

(st-test "setUp ran before test"
  (evp
    "| s r |
     s := FixtureCase suiteForAll: #(#testValueIs42).
     r := s run.
     ^ r passCount")
  1)

;; ── 6. should:raise: and shouldnt:raise: ──
(smalltalk-load
  "TestCase subclass: #RaiseCase
     instanceVariableNames: ''!

   !RaiseCase methodsFor: 'tests'!
   testShouldRaise
     self should: [Error signal: 'boom'] raise: Error!

   testShouldRaiseFails
     self should: [42] raise: Error!

   testShouldntRaise
     self shouldnt: [42] raise: Error! !")

(st-test "should:raise: catches matching"
  (evp
    "| r |
     r := (RaiseCase suiteForAll: #(#testShouldRaise)) run.
     ^ r passCount") 1)

(st-test "should:raise: fails when no exception"
  (evp
    "| r |
     r := (RaiseCase suiteForAll: #(#testShouldRaiseFails)) run.
     ^ r failureCount") 1)

(st-test "shouldnt:raise: passes when nothing thrown"
  (evp
    "| r |
     r := (RaiseCase suiteForAll: #(#testShouldntRaise)) run.
     ^ r passCount") 1)

;; ── 7. summary string uses format: ──
(st-test "summary contains pass count"
  (let
    ((s (evp
          "| s r |
           s := MixedCase suiteForAll: #(#testGood #testBad).
           r := s run.
           ^ r summary")))
    (cond
      ((not (string? s)) false)
      (else (> (len s) 0))))
  true)

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