;; Vendor a slice of Pharo Kernel-Tests / Collections-Tests.
;;
;; The .st files in tests/pharo/ define TestCase subclasses with `test*`
;; methods. This harness reads them, asks the SUnit framework for the
;; per-class test selector list, runs each test individually, and emits
;; one st-test row per Smalltalk test method — so each Pharo test counts
;; toward the scoreboard's grand total.

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

;; The runtime is already loaded by test.sh. The class table has SUnit
;; (also bootstrapped by test.sh). We need to install the Pharo test
;; classes before iterating them.

(define
  pharo-kernel-source
  "TestCase subclass: #IntegerTest instanceVariableNames: ''!

   !IntegerTest methodsFor: 'arithmetic'!
   testAddition self assert: 2 + 3 equals: 5!
   testSubtraction self assert: 10 - 4 equals: 6!
   testMultiplication self assert: 6 * 7 equals: 42!
   testDivisionExact self assert: 10 / 2 equals: 5!
   testNegation self assert: 7 negated equals: -7!
   testAbs self assert: -5 abs equals: 5!
   testZero self assert: 0 + 0 equals: 0!
   testIdentity self assert: 42 == 42! !

   !IntegerTest methodsFor: 'comparison'!
   testLessThan self assert: 1 < 2!
   testLessOrEqual self assert: 5 <= 5!
   testGreater self assert: 10 > 3!
   testEqualSelf self assert: 7 = 7!
   testNotEqual self assert: (3 ~= 5)!
   testBetween self assert: (5 between: 1 and: 10)! !

   !IntegerTest methodsFor: 'predicates'!
   testEvenTrue self assert: 4 even!
   testEvenFalse self deny: 5 even!
   testOdd self assert: 3 odd!
   testIsInteger self assert: 0 isInteger!
   testIsNumber self assert: 1 isNumber!
   testIsZero self assert: 0 isZero!
   testIsNotZero self deny: 1 isZero! !

   !IntegerTest methodsFor: 'powers and roots'!
   testFactorialZero self assert: 0 factorial equals: 1!
   testFactorialFive self assert: 5 factorial equals: 120!
   testRaisedTo self assert: (2 raisedTo: 8) equals: 256!
   testSquared self assert: 9 squared equals: 81!
   testSqrtPerfect self assert: 16 sqrt equals: 4!
   testGcd self assert: (24 gcd: 18) equals: 6!
   testLcm self assert: (4 lcm: 6) equals: 12! !

   !IntegerTest methodsFor: 'rounding'!
   testFloor self assert: 3.7 floor equals: 3!
   testCeiling self assert: 3.2 ceiling equals: 4!
   testTruncated self assert: -3.7 truncated equals: -3!
   testRounded self assert: 3.5 rounded equals: 4! !

   TestCase subclass: #StringTest instanceVariableNames: ''!

   !StringTest methodsFor: 'access'!
   testSize self assert: 'hello' size equals: 5!
   testEmpty self assert: '' isEmpty!
   testNotEmpty self assert: 'a' notEmpty!
   testAtFirst self assert: ('hello' at: 1) equals: 'h'!
   testAtLast self assert: ('hello' at: 5) equals: 'o'!
   testFirst self assert: 'world' first equals: 'w'!
   testLast self assert: 'world' last equals: 'd'! !

   !StringTest methodsFor: 'concatenation'!
   testCommaConcat self assert: 'hello, ' , 'world' equals: 'hello, world'!
   testEmptyConcat self assert: '' , 'x' equals: 'x'!
   testSelfConcat self assert: 'ab' , 'ab' equals: 'abab'! !

   !StringTest methodsFor: 'comparisons'!
   testEqual self assert: 'a' = 'a'!
   testNotEqualStr self deny: 'a' = 'b'!
   testIncludes self assert: ('banana' includes: $a)!
   testIncludesNot self deny: ('banana' includes: $z)!
   testIndexOf self assert: ('abcde' indexOf: $c) equals: 3! !

   !StringTest methodsFor: 'transforms'!
   testCopyFromTo self assert: ('helloworld' copyFrom: 6 to: 10) equals: 'world'! !

   TestCase subclass: #BooleanTest instanceVariableNames: ''!

   !BooleanTest methodsFor: 'logic'!
   testNotTrue self deny: true not!
   testNotFalse self assert: false not!
   testAnd self assert: (true & true)!
   testOr self assert: (true | false)!
   testIfTrueTaken self assert: (true ifTrue: [1] ifFalse: [2]) equals: 1!
   testIfFalseTaken self assert: (false ifTrue: [1] ifFalse: [2]) equals: 2!
   testAndShortCircuit self assert: (false and: [1/0]) equals: false!
   testOrShortCircuit self assert: (true or: [1/0]) equals: true! !")

(define
  pharo-collections-source
  "TestCase subclass: #ArrayTest instanceVariableNames: ''!

   !ArrayTest methodsFor: 'creation'!
   testNewSize self assert: (Array new: 5) size equals: 5!
   testLiteralSize self assert: #(1 2 3) size equals: 3!
   testEmpty self assert: #() isEmpty!
   testNotEmpty self assert: #(1) notEmpty!
   testFirst self assert: #(10 20 30) first equals: 10!
   testLast self assert: #(10 20 30) last equals: 30! !

   !ArrayTest methodsFor: 'access'!
   testAt self assert: (#(10 20 30) at: 2) equals: 20!
   testAtPut
     | a |
     a := Array new: 3.
     a at: 1 put: 'x'. a at: 2 put: 'y'. a at: 3 put: 'z'.
     self assert: (a at: 2) equals: 'y'! !

   !ArrayTest methodsFor: 'iteration'!
   testDoSum
     | s |
     s := 0.
     #(1 2 3 4 5) do: [:e | s := s + e].
     self assert: s equals: 15!

   testInjectInto self assert: (#(1 2 3 4) inject: 0 into: [:a :b | a + b]) equals: 10!

   testCollect self assert: (#(1 2 3) collect: [:x | x * x]) equals: #(1 4 9)!

   testSelect self assert: (#(1 2 3 4 5) select: [:x | x > 2]) equals: #(3 4 5)!

   testReject self assert: (#(1 2 3 4 5) reject: [:x | x > 2]) equals: #(1 2)!

   testDetect self assert: (#(1 3 5 7) detect: [:x | x > 4]) equals: 5!

   testCount self assert: (#(1 2 3 4 5) count: [:x | x even]) equals: 2!

   testAnySatisfy self assert: (#(1 2 3) anySatisfy: [:x | x > 2])!

   testAllSatisfy self assert: (#(2 4 6) allSatisfy: [:x | x even])!

   testIncludes self assert: (#(1 2 3) includes: 2)!

   testIncludesNotArr self deny: (#(1 2 3) includes: 99)!

   testIndexOfArr self assert: (#(10 20 30) indexOf: 30) equals: 3!

   testIndexOfMissing self assert: (#(1 2 3) indexOf: 99) equals: 0! !

   TestCase subclass: #DictionaryTest instanceVariableNames: ''!

   !DictionaryTest methodsFor: 'tests'!
   testEmpty self assert: Dictionary new isEmpty!

   testAtPutThenAt
     | d |
     d := Dictionary new.
     d at: #a put: 1.
     self assert: (d at: #a) equals: 1!

   testAtMissingNil self assert: (Dictionary new at: #nope) equals: nil!

   testAtIfAbsent
     self assert: (Dictionary new at: #nope ifAbsent: [#absent]) equals: #absent!

   testSize
     | d |
     d := Dictionary new.
     d at: #a put: 1. d at: #b put: 2. d at: #c put: 3.
     self assert: d size equals: 3!

   testIncludesKey
     | d |
     d := Dictionary new.
     d at: #a put: 1.
     self assert: (d includesKey: #a)!

   testRemoveKey
     | d |
     d := Dictionary new.
     d at: #a put: 1. d at: #b put: 2.
     d removeKey: #a.
     self deny: (d includesKey: #a)!

   testOverwrite
     | d |
     d := Dictionary new.
     d at: #x put: 1. d at: #x put: 99.
     self assert: (d at: #x) equals: 99! !

   TestCase subclass: #SetTest instanceVariableNames: ''!

   !SetTest methodsFor: 'tests'!
   testEmpty self assert: Set new isEmpty!

   testAdd
     | s |
     s := Set new.
     s add: 1.
     self assert: (s includes: 1)!

   testDedup
     | s |
     s := Set new.
     s add: 1. s add: 1. s add: 1.
     self assert: s size equals: 1!

   testRemove
     | s |
     s := Set new.
     s add: 1. s add: 2.
     s remove: 1.
     self deny: (s includes: 1)!

   testAddAll
     | s |
     s := Set new.
     s addAll: #(1 2 3 2 1).
     self assert: s size equals: 3!

   testDoSum
     | s sum |
     s := Set new.
     s add: 10. s add: 20. s add: 30.
     sum := 0.
     s do: [:e | sum := sum + e].
     self assert: sum equals: 60! !")

(smalltalk-load pharo-kernel-source)
(smalltalk-load pharo-collections-source)

;; Run each test method individually and create one st-test row per test.
;; A pharo test name like "IntegerTest >> testAddition" passes when the
;; SUnit run yields exactly one pass and zero failures.
(define
  pharo-test-class
  (fn
    (cls-name)
    (let ((selectors (sort (keys (get (st-class-get cls-name) :methods)))))
      (for-each
        (fn (sel)
          (when
            (and (>= (len sel) 4) (= (slice sel 0 4) "test"))
            (let
              ((src (str "| s r | s := " cls-name " suiteForAll: #(#"
                         sel "). r := s run.
                         ^ {(r passCount). (r failureCount). (r errorCount)}")))
              (let ((result (smalltalk-eval-program src)))
                (st-test
                  (str cls-name " >> " sel)
                  result
                  (list 1 0 0))))))
        selectors))))

(pharo-test-class "IntegerTest")
(pharo-test-class "StringTest")
(pharo-test-class "BooleanTest")
(pharo-test-class "ArrayTest")
(pharo-test-class "DictionaryTest")
(pharo-test-class "SetTest")

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