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

;; ANSI X3J20 Smalltalk validator — stretch subset.
;;
;; Targets the mandatory protocols documented in the standard; one test
;; case per ANSI §6.x category. Test methods are run through the SUnit
;; framework; one st-test row per Smalltalk method (mirrors tests/pharo.sx).

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

(define
  ansi-source
  "TestCase subclass: #AnsiObjectTest instanceVariableNames: ''!

   !AnsiObjectTest methodsFor: '6.10 Object'!
   testIdentity self assert: 42 == 42!
   testIdentityNotEq self deny: 'a' == 'b'!
   testEqualityIsAlsoIdentityOnInts self assert: 7 = 7!
   testNotEqual self assert: (1 ~= 2)!
   testIsNilOnNil self assert: nil isNil!
   testIsNilOnInt self deny: 1 isNil!
   testNotNil self assert: 42 notNil!
   testClass self assert: 42 class = SmallInteger!
   testYourself
     | x | x := 99.
     self assert: x yourself equals: 99! !

   TestCase subclass: #AnsiBooleanTest instanceVariableNames: ''!

   !AnsiBooleanTest methodsFor: '6.11 Boolean'!
   testNot self assert: true not equals: false!
   testAndTT self assert: (true & true)!
   testAndTF self deny: (true & false)!
   testAndFT self deny: (false & true)!
   testAndFF self deny: (false & false)!
   testOrTT self assert: (true | true)!
   testOrTF self assert: (true | false)!
   testOrFT self assert: (false | true)!
   testOrFF self deny: (false | false)!
   testIfTrueTaken self assert: (true ifTrue: [1] ifFalse: [2]) equals: 1!
   testIfFalseTaken self assert: (false ifTrue: [1] ifFalse: [2]) equals: 2!
   testAndShort self assert: (false and: [1/0]) equals: false!
   testOrShort self assert: (true or: [1/0]) equals: true! !

   TestCase subclass: #AnsiIntegerTest instanceVariableNames: ''!

   !AnsiIntegerTest methodsFor: '6.13 Integer'!
   testFactorial self assert: 6 factorial equals: 720!
   testGcd self assert: (12 gcd: 18) equals: 6!
   testLcm self assert: (4 lcm: 6) equals: 12!
   testEven self assert: 8 even!
   testOdd self assert: 9 odd!
   testNegated self assert: 5 negated equals: -5!
   testAbs self assert: -7 abs equals: 7! !

   !AnsiIntegerTest methodsFor: '6.12 Number arithmetic'!
   testAdd self assert: 1 + 2 equals: 3!
   testSub self assert: 10 - 4 equals: 6!
   testMul self assert: 6 * 7 equals: 42!
   testMin self assert: (3 min: 7) equals: 3!
   testMax self assert: (3 max: 7) equals: 7!
   testBetween self assert: (5 between: 1 and: 10)! !

   TestCase subclass: #AnsiStringTest instanceVariableNames: ''!

   !AnsiStringTest methodsFor: '6.17 String'!
   testSize self assert: 'abcdef' size equals: 6!
   testConcat self assert: ('foo' , 'bar') equals: 'foobar'!
   testAt self assert: ('abcd' at: 3) equals: 'c'!
   testCopyFromTo self assert: ('helloworld' copyFrom: 1 to: 5) equals: 'hello'!
   testAsSymbol self assert: 'foo' asSymbol == #foo!
   testIsEmpty self assert: '' isEmpty! !

   TestCase subclass: #AnsiArrayTest instanceVariableNames: ''!

   !AnsiArrayTest methodsFor: '6.18 Array'!
   testSize self assert: #(1 2 3) size equals: 3!
   testAt self assert: (#(10 20 30) at: 2) equals: 20!
   testAtPut
     | a |
     a := Array new: 3.
     a at: 1 put: 100.
     self assert: (a at: 1) equals: 100!
   testDo
     | s |
     s := 0.
     #(1 2 3) do: [:e | s := s + e].
     self assert: s equals: 6!
   testCollect self assert: (#(1 2 3) collect: [:x | x + 10]) equals: #(11 12 13)!
   testSelect self assert: (#(1 2 3 4) select: [:x | x even]) equals: #(2 4)!
   testReject self assert: (#(1 2 3 4) reject: [:x | x even]) equals: #(1 3)!
   testInject self assert: (#(1 2 3 4 5) inject: 0 into: [:a :b | a + b]) equals: 15!
   testIncludes self assert: (#(1 2 3) includes: 2)!
   testFirst self assert: #(7 8 9) first equals: 7!
   testLast self assert: #(7 8 9) last equals: 9! !

   TestCase subclass: #AnsiBlockTest instanceVariableNames: ''!

   !AnsiBlockTest methodsFor: '6.19 BlockContext'!
   testValue self assert: [42] value equals: 42!
   testValueOne self assert: ([:x | x * 2] value: 21) equals: 42!
   testValueTwo self assert: ([:a :b | a + b] value: 3 value: 4) equals: 7!
   testNumArgs self assert: [:a :b | a] numArgs equals: 2!
   testValueWithArguments
     self assert: ([:a :b | a , b] valueWithArguments: #('foo' 'bar')) equals: 'foobar'!
   testWhileTrue
     | n |
     n := 5.
     [n > 0] whileTrue: [n := n - 1].
     self assert: n equals: 0!
   testEnsureRunsOnNormal
     | log |
     log := Array new: 0.
     [log add: #body] ensure: [log add: #cleanup].
     self assert: log size equals: 2!
   testOnDoCatchesError
     | r |
     r := [Error signal: 'boom'] on: Error do: [:e | e messageText].
     self assert: r equals: 'boom'! !

   TestCase subclass: #AnsiSymbolTest instanceVariableNames: ''!

   !AnsiSymbolTest methodsFor: '6.16 Symbol'!
   testEqual self assert: #foo = #foo!
   testIdentity self assert: #bar == #bar!
   testNotEq self deny: #a == #b! !")

(smalltalk-load ansi-source)

(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 "AnsiObjectTest")
(pharo-test-class "AnsiBooleanTest")
(pharo-test-class "AnsiIntegerTest")
(pharo-test-class "AnsiStringTest")
(pharo-test-class "AnsiArrayTest")
(pharo-test-class "AnsiBlockTest")
(pharo-test-class "AnsiSymbolTest")

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