resin 0.3.1 → 0.4.0

data/amber/st/Kernel-Tests.st

@@ -5,18 +5,41 @@ TestCase subclass: #BlockClosureTest
 
 !BlockClosureTest methodsFor: 'tests'!
 
+testCanClearInterval
+	self shouldnt: [([Error new signal] valueWithInterval: 0) clearInterval] raise: Error
+!
+
+testCanClearTimeout
+	self shouldnt: [([Error new signal] valueWithTimeout: 0) clearTimeout] raise: Error
+!
+
 testCompiledSource
 	self assert: ([1+1] compiledSource includesSubString: 'function')
 !
 
 testEnsure
-	self assert: ([Error new] ensure: [true])
+	self assert: 3 equals: ([3] ensure: [4])
 !
 
 testEnsureRaises
 	self should: [[Error new signal] ensure: [true]] raise: Error
 !
 
+testExceptionSemantics
+	"See https://github.com/NicolasPetton/amber/issues/314"
+    self timeout: 100.
+    
+    (self async:  [ 
+    	[ 
+        	self assert: true. 
+            Error signal. 
+            "The following should *not* be run"
+            self deny: true.
+            self finished.
+  		] on: Error do: [ :ex | self finished ] 
+	]) valueWithTimeout: 0
+!
+
 testNumArgs
 	self assert: [] numArgs equals: 0.
 	self assert: [:a :b | ] numArgs equals: 2
@@ -121,6 +144,21 @@ testIfTrueIfFalse
 	self assert: (true ifFalse: ['alternative block'] ifTrue: ['alternative block2']) = 'alternative block2'.
 !
 
+testIfTrueIfFalseWithBoxing
+ 
+	self assert: (true yourself ifTrue: ['alternative block']) = 'alternative block'.
+	self assert: (true yourself ifFalse: ['alternative block']) = nil.
+
+	self assert: (false yourself ifTrue: ['alternative block']) = nil.
+	self assert: (false yourself ifFalse: ['alternative block']) = 'alternative block'.
+
+	self assert: (false yourself ifTrue: ['alternative block'] ifFalse: ['alternative block2']) = 'alternative block2'.
+	self assert: (false yourself ifFalse: ['alternative block'] ifTrue: ['alternative block2']) = 'alternative block'.
+
+	self assert: (true yourself ifTrue: ['alternative block'] ifFalse: ['alternative block2']) = 'alternative block'.
+	self assert: (true yourself ifFalse: ['alternative block'] ifTrue: ['alternative block2']) = 'alternative block2'.
+!
+
 testLogic
  
 	"Trivial logic table"
@@ -157,9 +195,7 @@ testLogicKeywords
 !
 
 testNonBooleanError
-	|b|
-    b := < '' >.
-    self should: [nonBoolean ifTrue: [] ifFalse: []] raise: NonBooleanReceiver
+    self should: [ '' ifTrue: [] ifFalse: [] ] raise: NonBooleanReceiver
 ! !
 
 TestCase subclass: #ClassBuilderTest
@@ -185,6 +221,66 @@ testClassCopy
 	self assert: theClass methodDictionary keys equals: ObjectMock methodDictionary keys
 !
 
+testClassMigration
+	| instance oldClass |
+    
+    oldClass := builder copyClass: ObjectMock named: 'ObjectMock2'.
+    instance := (Smalltalk  current at: 'ObjectMock2') new.
+    
+    "Change the superclass of ObjectMock2"
+    ObjectMock subclass: (Smalltalk current at: 'ObjectMock2')
+    	instanceVariableNames: ''
+        package: 'Kernel-Tests'.
+    
+    self deny: oldClass == ObjectMock2.
+    
+	self assert: ObjectMock2 superclass == ObjectMock.
+	self assert: ObjectMock2 instanceVariableNames isEmpty.
+	self assert: ObjectMock2 selectors equals: oldClass selectors.
+    self assert: ObjectMock2 comment equals: oldClass comment.
+    self assert: ObjectMock2 package name equals: 'Kernel-Tests'.
+    
+	self deny: instance class == ObjectMock2.
+    self assert: instance class name equals: 'OldObjectMock2'.
+    
+    self assert: (Smalltalk current at: 'OldObjectMock2') isNil.
+    
+    Smalltalk current removeClass: ObjectMock2
+!
+
+testClassMigrationWithClassInstanceVariables
+    
+    builder copyClass: ObjectMock named: 'ObjectMock2'.
+    ObjectMock2 class instanceVariableNames: 'foo bar'.
+    
+    "Change the superclass of ObjectMock2"
+    ObjectMock subclass: (Smalltalk current at: 'ObjectMock2')
+    	instanceVariableNames: ''
+        package: 'Kernel-Tests'.
+    
+    self assert: ObjectMock2 class instanceVariableNames equals: #('foo' 'bar').
+    
+    Smalltalk current removeClass: ObjectMock2
+!
+
+testClassMigrationWithSubclasses
+    
+    builder copyClass: ObjectMock named: 'ObjectMock2'.
+    ObjectMock2 subclass: 'ObjectMock3' instanceVariableNames: '' package: 'Kernel-Tests'.
+    ObjectMock3 subclass: 'ObjectMock4' instanceVariableNames: '' package: 'Kernel-Tests'.
+    
+    "Change the superclass of ObjectMock2"
+    ObjectMock subclass: (Smalltalk current at: 'ObjectMock2')
+    	instanceVariableNames: ''
+        package: 'Kernel-Tests'.
+    
+    self assert: (ObjectMock subclasses includes: ObjectMock2).
+    self assert: (ObjectMock2 subclasses includes: ObjectMock3).
+    self assert: (ObjectMock3 subclasses includes: ObjectMock4).
+    
+    ObjectMock allSubclasses do: [ :each | Smalltalk current removeClass: each ]
+!
+
 testInstanceVariableNames
 	self assert: (builder instanceVariableNamesFor: '  hello   world   ') equals: #('hello' 'world')
 ! !
@@ -826,7 +922,7 @@ TestCase subclass: #JSObjectProxyTest
 !JSObjectProxyTest methodsFor: 'accessing'!
 
 jsObject
-	<return jsObject = {a: 1, b: function() {return 2;}, c: function(object) {return object;}, d: ''}>
+	<return jsObject = {a: 1, b: function() {return 2;}, c: function(object) {return object;}, d: '', 'e': null}>
 ! !
 
 !JSObjectProxyTest methodsFor: 'tests'!
@@ -860,6 +956,14 @@ testPropertyThatReturnsEmptyString
 	self assert: 'hello' equals: object d
 !
 
+testPropertyThatReturnsUndefined
+	| object |
+
+	object := self jsObject.
+	self shouldnt: [ object e ]  raise: MessageNotUnderstood.
+    self assert: object e isNil
+!
+
 testYourself
 	| object |
 	object := self jsObject
@@ -869,6 +973,29 @@ testYourself
 	self assert: object d equals: 'test'
 ! !
 
+TestCase subclass: #JavaScriptExceptionTest
+	instanceVariableNames: ''
+	package: 'Kernel-Tests'!
+
+!JavaScriptExceptionTest methodsFor: 'helpers'!
+
+throwException
+	<throw 'test'>
+! !
+
+!JavaScriptExceptionTest methodsFor: 'testing'!
+
+testCatchingException
+	[ self throwException ]
+  		on: Error
+        do: [ :error | 
+			self assert: error exception = 'test' ]
+!
+
+testRaisingException
+	self should: [ self throwException ] raise: JavaScriptException
+! !
+
 TestCase subclass: #NumberTest
 	instanceVariableNames: ''
 	package: 'Kernel-Tests'!
@@ -931,6 +1058,17 @@ testEquality
 	self deny: 0 = ''
 !
 
+testHexNumbers
+
+	self assert: 16r9 = 9.
+	self assert: 16rA truncated = 10.
+	self assert: 16rB truncated = 11.
+	self assert: 16rC truncated = 12.
+	self assert: 16rD truncated = 13.
+	self assert: 16rE truncated = 14.
+	self assert: 16rF truncated = 15
+!
+
 testIdentity
 	self assert: 1 == 1.
 	self assert: 0 == 0.
@@ -943,6 +1081,51 @@ testIdentity
 	self deny: 1 == 2
 !
 
+testInvalidHexNumbers
+
+	self should: [16rG] raise: MessageNotUnderstood.
+   	self should: [16rg] raise: MessageNotUnderstood.
+	self should: [16rH] raise: MessageNotUnderstood.
+   	self should: [16rh] raise: MessageNotUnderstood.
+	self should: [16rI] raise: MessageNotUnderstood.
+   	self should: [16ri] raise: MessageNotUnderstood.
+	self should: [16rJ] raise: MessageNotUnderstood.
+   	self should: [16rj] raise: MessageNotUnderstood.
+	self should: [16rK] raise: MessageNotUnderstood.
+   	self should: [16rk] raise: MessageNotUnderstood.
+	self should: [16rL] raise: MessageNotUnderstood.
+   	self should: [16rl] raise: MessageNotUnderstood.
+	self should: [16rM] raise: MessageNotUnderstood.
+   	self should: [16rm] raise: MessageNotUnderstood.
+	self should: [16rN] raise: MessageNotUnderstood.
+   	self should: [16rn] raise: MessageNotUnderstood.
+	self should: [16rO] raise: MessageNotUnderstood.
+   	self should: [16ro] raise: MessageNotUnderstood.
+	self should: [16rP] raise: MessageNotUnderstood.
+   	self should: [16rp] raise: MessageNotUnderstood.
+	self should: [16rQ] raise: MessageNotUnderstood.
+   	self should: [16rq] raise: MessageNotUnderstood.
+	self should: [16rR] raise: MessageNotUnderstood.
+   	self should: [16rr] raise: MessageNotUnderstood.
+	self should: [16rS] raise: MessageNotUnderstood.
+   	self should: [16rs] raise: MessageNotUnderstood.
+	self should: [16rT] raise: MessageNotUnderstood.
+   	self should: [16rt] raise: MessageNotUnderstood.
+	self should: [16rU] raise: MessageNotUnderstood.
+   	self should: [16ru] raise: MessageNotUnderstood.
+	self should: [16rV] raise: MessageNotUnderstood.
+   	self should: [16rv] raise: MessageNotUnderstood.
+	self should: [16rW] raise: MessageNotUnderstood.
+   	self should: [16rw] raise: MessageNotUnderstood.
+	self should: [16rX] raise: MessageNotUnderstood.
+   	self should: [16rx] raise: MessageNotUnderstood.
+	self should: [16rY] raise: MessageNotUnderstood.
+   	self should: [16ry] raise: MessageNotUnderstood.
+	self should: [16rZ] raise: MessageNotUnderstood.
+   	self should: [16rz] raise: MessageNotUnderstood.
+    self should: [16rABcdEfZ] raise: MessageNotUnderstood.
+!
+
 testMinMax
 	
 	self assert: (2 max: 5) equals: 5.
@@ -1019,6 +1202,8 @@ testTruncated
 Object subclass: #ObjectMock
 	instanceVariableNames: 'foo bar'
 	package: 'Kernel-Tests'!
+!ObjectMock commentStamp!
+ObjectMock is there only to perform tests on classes.!
 
 !ObjectMock methodsFor: 'not yet classified'!
 
@@ -1036,6 +1221,10 @@ TestCase subclass: #ObjectTest
 
 !ObjectTest methodsFor: 'tests'!
 
+notDefined
+	<return undefined;>
+!
+
 testBasicAccess
 	| o |
 	o := Object new.
@@ -1102,11 +1291,7 @@ testInstVars
 testNilUndefined
 	"nil in Smalltalk is the undefined object in JS"
 
-	| notDefined |
-    
-    <notDefined = undefined>.
-
-	self assert: nil = notDefined
+	self assert: nil = self notDefined
 !
 
 testYourself

data/amber/st/Kernel-Transcript.st

@@ -19,9 +19,7 @@ cr
 !
 
 show: anObject
-	| string |
-	string := anObject asString.
-	<console.log(String(string))>
+	<console.log(String(string._asString()))>
 ! !
 
 !ConsoleTranscript class methodsFor: 'initialization'!

data/amber/st/SUnit-Tests.st

@@ -0,0 +1,186 @@
+Smalltalk current createPackage: 'SUnit-Tests' properties: #{}!
+TestCase subclass: #ExampleSetTest
+	instanceVariableNames: 'empty full'
+	package: 'SUnit-Tests'!
+!ExampleSetTest commentStamp!
+ExampleSetTest is taken from Pharo 1.4.
+
+THe purpose of this class is to demonstrate a simple use case of the test framework.!
+
+!ExampleSetTest methodsFor: 'running'!
+
+setUp
+	empty := Set new.
+	full := Set with: 5 with: #abc
+! !
+
+!ExampleSetTest methodsFor: 'tests'!
+
+testAdd
+	empty add: 5.
+	self assert: (empty includes: 5)
+!
+
+testGrow
+	empty addAll: (1 to: 100).
+	self assert: empty size = 100
+!
+
+testIllegal
+	self 
+		should: [empty at: 5] 
+		raise: Error.
+	self 
+		should: [empty at: 5 put: #abc] 
+		raise: Error
+!
+
+testIncludes
+	self assert: (full includes: 5).
+	self assert: (full includes: #abc)
+!
+
+testOccurrences
+	self assert: (empty occurrencesOf: 0) = 0.
+	self assert: (full occurrencesOf: 5) = 1.
+	full add: 5.
+	self assert: (full occurrencesOf: 5) = 1
+!
+
+testRemove
+	full remove: 5.
+	self assert: (full includes: #abc).
+	self deny: (full includes: 5)
+! !
+
+TestCase subclass: #SUnitAsyncTest
+	instanceVariableNames: 'flag'
+	package: 'SUnit-Tests'!
+
+!SUnitAsyncTest methodsFor: 'helpers'!
+
+fakeError
+	flag := 'bad'.
+	self timeout: 10.
+    flag := (self async: [ flag := 'ok'. self error: 'Intentional' ]) valueWithTimeout: 5
+!
+
+fakeErrorFailingInTearDown
+	flag := 'bad'.
+	self timeout: 10.
+    flag := (self async: [ self error: 'Intentional' ]) valueWithTimeout: 5
+!
+
+fakeFailure
+	flag := 'bad'.
+	self timeout: 10.
+    flag := (self async: [ flag := 'ok'. self assert: false ]) valueWithTimeout: 5
+!
+
+fakeMultipleTimeoutFailing
+	self timeout: 100.
+    (self async: [
+		self timeout: 5.
+        (self async: [ self finished ]) valueWithTimeout: 10
+	]) valueWithTimeout: 5
+!
+
+fakeMultipleTimeoutPassing
+	self timeout: 10.
+    (self async: [
+		self timeout: 20.
+        (self async: [ self finished ]) valueWithTimeout: 10
+	]) valueWithTimeout: 5
+!
+
+fakeTimeout
+	self timeout: 4.
+    (self async: [ self finished ]) valueWithTimeout: 5
+! !
+
+!SUnitAsyncTest methodsFor: 'private'!
+
+sortedSelectors: aCollection
+	^(aCollection collect: [:each | each selector]) sorted
+! !
+
+!SUnitAsyncTest methodsFor: 'running'!
+
+setUp
+	flag := 'ok'
+!
+
+tearDown
+	self assert: 'ok' equals: flag
+! !
+
+!SUnitAsyncTest methodsFor: 'tests'!
+
+testAsyncErrorsAndFailures
+	| suite runner result assertBlock |
+	suite := #('fakeError' 'fakeErrorFailingInTearDown' 'fakeFailure' 'testPass') collect: [ :each | self class selector: each ].
+    runner := TestSuiteRunner on: suite.
+    self timeout: 200.
+	result := runner result.
+    assertBlock := self async: [
+		self assert: #('fakeError') equals: (self sortedSelectors: result errors).
+		self assert: #('fakeErrorFailingInTearDown' 'fakeFailure') equals: (self sortedSelectors: result failures).
+		self finished
+  	].
+    runner announcer on: ResultAnnouncement do: [:ann |
+    	ann result == result  ifTrue: [ result runs = result total ifTrue: assertBlock ]].
+	runner run
+!
+
+testAsyncNeedsTimeout
+    self should: [ self async: [ ] ] raise: Error.
+    self timeout: 0.
+    self shouldnt: [ self async: [ ] ] raise: Error.
+    self finished
+!
+
+testFinishedNeedsTimeout
+    self should: [ self finished ] raise: Error.
+    self timeout: 0.
+    self shouldnt: [ self finished ] raise: Error.
+!
+
+testIsAsyncReturnsCorrectValues
+    self deny: self isAsync.
+    self timeout: 0.
+    self assert: self isAsync.
+    self finished.
+    self deny: self isAsync
+!
+
+testPass
+	flag := 'bad'.
+	self timeout: 10.
+    flag := (self async: [ self assert: true. self finished. flag := 'ok' ]) valueWithTimeout: 5
+!
+
+testTimeouts
+	| suite runner result assertBlock |
+	suite := #('fakeTimeout' 'fakeMultipleTimeoutFailing' 'fakeMultipleTimeoutPassing' 'testPass') collect: [ :each | self class selector: each ].
+    runner := TestSuiteRunner on: suite.
+    self timeout: 200.
+	result := runner result.
+    assertBlock := self async: [
+		self assert: result errors isEmpty.
+		self assert: #('fakeMultipleTimeoutFailing' 'fakeTimeout') equals: (self sortedSelectors: result failures).
+		self finished
+  	].
+    runner announcer on: ResultAnnouncement do: [:ann |
+    	ann result == result  ifTrue: [ result runs = result total ifTrue: assertBlock ]].
+	runner run
+!
+
+testTwoAsyncPassesWithFinishedOnlyOneIsRun
+	| x |
+	flag := 'bad'.
+	self timeout: 10.
+    x := 0.
+    flag := (self async: [ self finished. flag := 'ok'. x := x+1. self assert: 1 equals: x ]) valueWithTimeout: 0.
+    flag := (self async: [ self finished. flag := 'ok'. x := x+1. self assert: 1 equals: x ]) valueWithTimeout: 0.
+! !
+