giles
446a0e7d68
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
265 lines
8.5 KiB
Plaintext
265 lines
8.5 KiB
Plaintext
;; 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)
|