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