[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] convert regression tests to new syntax
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] [PATCH] convert regression tests to new syntax |
|
Date: |
Wed, 11 Apr 2007 15:08:02 +0200 |
|
User-agent: |
Thunderbird 1.5.0.10 (Macintosh/20070221) |
Here are the regression tests converted to the new syntax.
The automatic converter will come later, for now this is done by hand.
There are some problems in mutate.st which will be addressed later, all
other tests pass.
Paolo
--- orig/tests/ackermann.ok
+++ mod/tests/ackermann.ok
@@ -1,7 +1,4 @@
Execution begins...
-returned value is Integer
-
-Execution begins...
Ack(3,4): 125
returned value is 'Ack(3,4): 125'
--- orig/tests/ackermann.st
+++ mod/tests/ackermann.st
@@ -28,16 +28,19 @@
|
======================================================================"
-!Integer methodsFor: 'bench'!
+Integer extend [
+ ack: n [
+ self = 0 ifTrue: [ ^n + 1 ].
+ n = 0 ifTrue: [ ^self - 1 ack: 1 ].
+ ^self - 1 ack: (self ack: n - 1)
+ ]
+]
-ack: n
- self = 0 ifTrue: [ ^n + 1 ].
- n = 0 ifTrue: [ ^self - 1 ack: 1 ].
- ^self - 1 ack: (self ack: n - 1)! !
-
-| n |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 4 ]
ifFalse: [ Smalltalk arguments first asInteger ].
-('Ack(3,%1): %2' bindWith: n with: (3 ack: n)) displayNl!
+ ('Ack(3,%1): %2' bindWith: n with: (3 ack: n)) displayNl
+
+]
--- orig/tests/arrays.ok
+++ mod/tests/arrays.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is Object
-
-Execution begins...
returned value is Array new: 3 "<0>"
Execution begins...
--- orig/tests/arrays.st
+++ mod/tests/arrays.st
@@ -28,116 +28,118 @@
|
======================================================================"
-!Object methodsFor: 'testing'!
+Object extend [
-arrayConstTest1
- | a |
- a := #(#foo #bar 'quem').
- ^a
-!
-
-arrayConstTest2
- | a |
- a := #(#foo #bar 'quem').
- ^a class
-!
-
-arrayConstTest3
- | a |
- a := #(#foo #bar 'quem').
- ^a size
-!
-
-arrayConstTest4
- | a |
- a := #(#foo (#a #sub #array) #bar 'quem' 3.4 1 $C #barn:yard:owl: #baz).
- ^a class
-!
-
-arrayConstSubscriptTest
- | a |
- a := #(#foo (#a #sub #array) #bar 'quem' 3.4 1 $C #barn:yard:owl: #baz).
- ^a at: self
-!
-
-arrayTrueFalseNilTest
- | a |
- a := #(true #true false #false nil #nil).
- a do: [ :each | each class printNl ]
-!
-
-newArray1
- | a |
- a := Array new: 10.
- ^a class
-!
-
-newArray2
- | a |
- a := Array new: 10.
- a at: self put: self.
- ^a at: self
-! !
-
-^nil arrayConstTest1!
-
-^nil arrayConstTest2!
-
-^nil arrayConstTest3!
-
-^nil arrayConstTest4!
-
-^1 arrayConstSubscriptTest!
-^2 arrayConstSubscriptTest!
-^3 arrayConstSubscriptTest!
-^4 arrayConstSubscriptTest!
-^5 arrayConstSubscriptTest!
-^6 arrayConstSubscriptTest!
-^7 arrayConstSubscriptTest!
-^8 arrayConstSubscriptTest!
-^9 arrayConstSubscriptTest!
-
-^nil newArray1!
-
-^1 newArray2!
-^5 newArray2!
-^10 newArray2!
-
-^nil arrayTrueFalseNilTest!
-
-^ByteArray with: -1!
-^ByteArray with: 0!
-^ByteArray with: 255!
-^ByteArray with: 256!
-^WordArray with: (-1 bitShift: 64)!
-^WordArray with: -1!
-^WordArray with: 0!
-^WordArray with: 255!
-^WordArray with: 256!
-^WordArray with: (1 bitShift: 64)!
+ arrayConstTest1 [
+ | a |
+ a := #(#foo #bar 'quem').
+ ^a
+ ]
+
+ arrayConstTest2 [
+ | a |
+ a := #(#foo #bar 'quem').
+ ^a class
+ ]
+
+ arrayConstTest3 [
+ | a |
+ a := #(#foo #bar 'quem').
+ ^a size
+ ]
+
+ arrayConstTest4 [
+ | a |
+ a := #(#foo (#a #sub #array) #bar 'quem' 3.4 1 $C #barn:yard:owl:
#baz).
+ ^a class
+ ]
+
+ arrayConstSubscriptTest [
+ | a |
+ a := #(#foo (#a #sub #array) #bar 'quem' 3.4 1 $C #barn:yard:owl:
#baz).
+ ^a at: self
+ ]
+
+ arrayTrueFalseNilTest [
+ | a |
+ a := #(true #true false #false nil #nil).
+ a do: [ :each | each class printNl ]
+ ]
+
+ newArray1 [
+ | a |
+ a := Array new: 10.
+ ^a class
+ ]
+
+ newArray2 [
+ | a |
+ a := Array new: 10.
+ a at: self put: self.
+ ^a at: self
+ ]
+]
+
+Eval [ nil arrayConstTest1 ]
+
+Eval [ nil arrayConstTest2 ]
+
+Eval [ nil arrayConstTest3 ]
+
+Eval [ nil arrayConstTest4 ]
+
+Eval [ 1 arrayConstSubscriptTest ]
+Eval [ 2 arrayConstSubscriptTest ]
+Eval [ 3 arrayConstSubscriptTest ]
+Eval [ 4 arrayConstSubscriptTest ]
+Eval [ 5 arrayConstSubscriptTest ]
+Eval [ 6 arrayConstSubscriptTest ]
+Eval [ 7 arrayConstSubscriptTest ]
+Eval [ 8 arrayConstSubscriptTest ]
+Eval [ 9 arrayConstSubscriptTest ]
+
+Eval [ nil newArray1 ]
+
+Eval [ 1 newArray2 ]
+Eval [ 5 newArray2 ]
+Eval [ 10 newArray2 ]
+
+Eval [ nil arrayTrueFalseNilTest ]
+
+Eval [ ByteArray with: -1 ]
+Eval [ ByteArray with: 0 ]
+Eval [ ByteArray with: 255 ]
+Eval [ ByteArray with: 256 ]
+Eval [ WordArray with: (-1 bitShift: 64) ]
+Eval [ WordArray with: -1 ]
+Eval [ WordArray with: 0 ]
+Eval [ WordArray with: 255 ]
+Eval [ WordArray with: 256 ]
+Eval [ WordArray with: (1 bitShift: 64) ]
"-----------------"
"used to trigger a failure in the verifier"
-^{{}} printString!
+Eval [ {{}} printString ]
"-----------------"
"This test used to fail because #removeAtIndex: was not implemented
in SortedCollection."
-| n4 n5 n6 n7 n8 n9 n10 n12 sc |
-n4 := 4->2. n5 := 5->3. n6 := 6->3.
-n7 := 7->2. n8 := 8->1. n9 := 9->8.
-n10 := 10->8. n12 := 12->1.
-
-sc := SortedCollection new: 10.
-sc sortBlock: [ :a :b |
- a value < b value
- or: [ a value = b value and: [ a key <= b key ] ] ].
-
-sc addAll: { n8. n12. n4. n7. n5. n6. n9. n10 }.
-sc remove: n10.
-sc remove: n8.
-sc add: n8.
-sc printNl!
+Eval [
+ n4 := 4->2. n5 := 5->3. n6 := 6->3.
+ n7 := 7->2. n8 := 8->1. n9 := 9->8.
+ n10 := 10->8. n12 := 12->1.
+
+ sc := SortedCollection new: 10.
+ sc sortBlock: [ :a :b |
+ a value < b value
+ or: [ a value = b value and: [ a key <= b key ] ] ].
+
+ sc addAll: { n8. n12. n4. n7. n5. n6. n9. n10 }.
+ sc remove: n10.
+ sc remove: n8.
+ sc add: n8.
+ sc printNl
+]
--- orig/tests/ary3.st
+++ mod/tests/ary3.st
@@ -28,14 +28,15 @@
|
======================================================================"
-| n x y |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-x := (1 to: n) asArray.
-y := Array new: n withAll: 0.
-1000 timesRepeat: [
- n to: 1 by: -1 do: [ :i | y at: i put: (y at: i) + (x at: i) ]
-].
-('%1 %2' bindWith: y first with: y last) displayNl!
+ x := (1 to: n) asArray.
+ y := Array new: n withAll: 0.
+ 1000 timesRepeat: [
+ n to: 1 by: -1 do: [ :i | y at: i put: (y at: i) + (x at: i) ]
+ ].
+ ('%1 %2' bindWith: y first with: y last) displayNl
+]
--- orig/tests/blocks.ok
+++ mod/tests/blocks.ok
@@ -3,9 +3,6 @@ Execution begins...
returned value is BlockClosure new "<0>"
Execution begins...
-returned value is BlockClosure new "<0>"
-
-Execution begins...
returned value is #quem
Execution begins...
@@ -18,9 +15,6 @@ Execution begins...
returned value is 17
Execution begins...
-returned value is Object
-
-Execution begins...
returned value is nil
Execution begins...
--- orig/tests/blocks.st
+++ mod/tests/blocks.st
@@ -28,127 +28,128 @@
|
======================================================================"
-[45]! "should return nil"
+Eval [ [45] ] "should return a block"
-^[45]! "should return a block"
+Eval [ [^#quem] value ] "should return #quem"
-[^#quem] value! "should return #quem"
+Eval [ ['foo'] value ] "should return 'foo'"
-^['foo'] value! "should return 'foo'"
+Eval [ [:i | i] value: 'juma' ] "should return 'juma'"
-^[:i | i] value: 'juma'! "should return 'juma'"
+Eval [ [:i :j| j] value: 12 value: 17 ] "should return 17"
-^[:i :j| j] value: 12 value: 17! "should return 17"
+Object extend [
-!Object methodsFor: 'testing'!
-
-blockTest1
- [#foo]
-!
+ blockTest1 [
+ [#foo]
+ ]
-blockTest2
- [^#foo]
-!
+ blockTest2 [
+ [^#foo]
+ ]
-blockTest3
- ^[#bar]
-!
+ blockTest3 [
+ ^[#bar]
+ ]
-blockTest4
- ^[^#bar]
-!
+ blockTest4 [
+ ^[^#bar]
+ ]
-blockTest5: arg
- ^[arg]
-!
+ blockTest5: arg [
+ ^[arg]
+ ]
-blockTest6: arg
- ^[:i | arg at: i]
-!
+ blockTest6: arg [
+ ^[:i | arg at: i]
+ ]
-blockTest7: arg
- | temp |
- temp := (arg at: 4) + 8.
- ^[temp]
-!
+ blockTest7: arg [
+ | temp |
+ temp := (arg at: 4) + 8.
+ ^[temp]
+ ]
-blockTest8: which
- | first second |
- first := nil blockTest7: #('one' #two 3.0 4 $5).
- second := nil blockTest7: #("You are[,] number" 'six' #seven 8.0 9 $A).
- which ifTrue: [ ^first value ]
- ifFalse: [ ^second value]
-!
+ blockTest8: which [
+ | first second |
+ first := nil blockTest7: #('one' #two 3.0 4 $5).
+ second := nil blockTest7: #("You are[,] number" 'six' #seven 8.0 9 $A).
+ which ifTrue: [ ^first value ]
+ ifFalse: [ ^second value]
+ ]
"Implements a 'closure'!!! Smalltalk is AMAZING!!!"
-blockTest9: initialValue
- | counter |
- counter := initialValue.
- ^[:incr | counter := counter + incr.
- counter]
-!
-
-"Implements a REAL 'closure'!!! GNU Smalltalk is AMAZING!!!"
-blockTest10
- | counter |
- counter := 1.
- "If blocks were not real closures, variable would be 1 the
- second time the block was called and hence it would not
- be modified.
- Instead if blocks are closures, variable is still nil the
- second time the block is evaluated, and is initialized to
- two. eh eh eh!!"
- ^[ | variable |
- variable isNil ifTrue: [ variable := counter ].
- counter := counter + 1.
- variable
- ]
-!
-
-blockTest11: initialValue
- ^[^initialValue]
-
-! !
+ blockTest9: initialValue [
+ | counter |
+ counter := initialValue.
+ ^[:incr | counter := counter + incr.
+ counter]
+ ]
-^nil blockTest1! "should return nil"
+ "Implements a REAL 'closure'!!! GNU Smalltalk is AMAZING!!!"
+ blockTest10 [
+ | counter |
+ counter := 1.
+ "If blocks were not real closures, variable would be 1 the
+ second time the block was called and hence it would not
+ be modified.
+ Instead if blocks are closures, variable is still nil the
+ second time the block is evaluated, and is initialized to
+ two."
+ ^[ | variable |
+ variable isNil ifTrue: [ variable := counter ].
+ counter := counter + 1.
+ variable
+ ]
+ ]
-^nil blockTest2! "should return nil"
+ blockTest11: initialValue [
+ ^[^initialValue]
+ ]
+]
-^nil blockTest3! "should return a BlockClosure"
-^nil blockTest3 value! "should return #bar"
+Eval [ nil blockTest1 ] "should return nil"
-^nil blockTest4 value! "should issue an error, we're returning to
+Eval [ nil blockTest2 ] "should return nil"
+
+Eval [ nil blockTest3 ] "should return a BlockClosure"
+Eval [ nil blockTest3 value ] "should return #bar"
+
+Eval [ nil blockTest4 value ] "should issue an error, we're returning
to
a non-existent context"
-^(nil blockTest5: 'Smalltalk!') value!
+Eval [ (nil blockTest5: 'Smalltalk!') value ]
"should return 'Smalltalk!'"
-^(nil blockTest6: #('one' #two 3.0 4 $5)) value: 2!
+Eval [ (nil blockTest6: #('one' #two 3.0 4 $5)) value: 2 ]
"should return #two"
-^(nil blockTest7: #('you' #are #number 6)) value!
+Eval [ (nil blockTest7: #('you' #are #number 6)) value ]
"should return 14"
-^nil blockTest8: true! "should return 12"
-^nil blockTest8: false! "should return 17"
+Eval [ nil blockTest8: true ] "should return 12"
+Eval [ nil blockTest8: false ] "should return 17"
"Create a block with the initial value of 2"
-Smalltalk at: #testBlock put: (nil blockTest9: 2)!
+Eval [ Smalltalk at: #testBlock put: (nil blockTest9: 2) ]
-^testBlock value: 3! "should return 5"
-^testBlock value: 6! "should return 11"
-^testBlock value: 2! "should return 13"
+Eval [ testBlock value: 3 ] "should return 5"
+Eval [ testBlock value: 6 ] "should return 11"
+Eval [ testBlock value: 2 ] "should return 13"
-Smalltalk at: #testBlock put: (nil blockTest10)!
+Eval [ Smalltalk at: #testBlock put: (nil blockTest10) ]
-^testBlock value! "should return 1"
-^testBlock value! "should return 2 (1 if blocks aren't closures)"
+Eval [ testBlock value ] "should return 1"
+Eval [ testBlock value ] "should return 2 (1 if blocks aren't
closures)"
"And this is even more amazing!!!"
-| array |
-array := (1 to: 10) collect: [ :each | [each] ].
-^array inject: 0 into: [ :sum :each | sum + each value ]! "should get 55"
+Eval [
+ | array |
+ array := (1 to: 10) collect: [ :each | [each] ].
+ ^array inject: 0 into: [ :sum :each | sum + each value ] "should get 55"
+]
+
-^(nil blockTest11: 3) value! "should be invalid; we're returning to non-
- existent parent"
+Eval [ (nil blockTest11: 3) value ] "should be invalid; we're returning to
non-
+ existent parent"
--- orig/tests/chars.st
+++ mod/tests/chars.st
@@ -28,64 +28,64 @@
|
======================================================================"
-^$A!
+Eval [ $A ]
-^$b!
+Eval [ $b ]
-^$$!
+Eval [ $$ ]
-^$! !
+Eval [ $! ]
-^$ !
-
-| a b c |
-a := 0 to: 255.
-b := a collect: [ :each | each asCharacter ].
-c := b collect: [ :each | each asInteger ].
-
-^c = a asArray!
-
-
-
-| allChars |
-allChars := (0 to: 127) asByteArray asString.
-
-^(0 to: 127) allSatisfy: [ :index |
- (allChars at: index + 1) == index asCharacter ]!
-
-
-
-| which allChars |
-allChars := (0 to: 255) asByteArray asString.
-
-#(#isVowel #isLetter #isUppercase #isLowercase #isAlphaNumeric
- #isDigit #isSeparator)
- do: [ :symbol |
- symbol printNl.
-
- which := allChars collect: [ :each |
- (each perform: symbol) ifTrue: [ $x ] ifFalse: [ $_ ]
- ].
-
- Transcript showCr: (which copyFrom: 1 to: 64).
- Transcript showCr: (which copyFrom: 65 to: 128).
- Transcript showCr: (which copyFrom: 129 to: 192).
- Transcript showCr: (which copyFrom: 193 to: 256).
- Transcript nl.
- ]!
-
-| which printable |
-
-printable := (33 to: 126) asByteArray asString.
-
-#(#asUppercase #asLowercase)
- do: [ :symbol |
- symbol printNl.
-
- which := printable collect: [ :each | (each perform: symbol) ].
-
- Transcript showCr: (which copyFrom: 1 to: 47).
- Transcript showCr: (which copyFrom: 48 to: 94).
- Transcript nl.
- ]
-!
+Eval [ $ ]
+
+Eval [
+ a := 0 to: 255.
+ b := a collect: [ :each | each asCharacter ].
+ c := b collect: [ :each | each asInteger ].
+
+ c = a asArray
+]
+
+
+Eval [
+ allChars := (0 to: 127) asByteArray asString.
+
+ ^(0 to: 127) allSatisfy: [ :index |
+ (allChars at: index + 1) == index asCharacter ]
+]
+
+
+Eval [
+ allChars := (0 to: 255) asByteArray asString.
+
+ #(#isVowel #isLetter #isUppercase #isLowercase #isAlphaNumeric
+ #isDigit #isSeparator)
+ do: [ :symbol |
+ symbol printNl.
+
+ which := allChars collect: [ :each |
+ (each perform: symbol) ifTrue: [ $x ] ifFalse: [ $_ ]
+ ].
+
+ Transcript showCr: (which copyFrom: 1 to: 64).
+ Transcript showCr: (which copyFrom: 65 to: 128).
+ Transcript showCr: (which copyFrom: 129 to: 192).
+ Transcript showCr: (which copyFrom: 193 to: 256).
+ Transcript nl.
+ ]
+]
+
+Eval [
+ printable := (33 to: 126) asByteArray asString.
+
+ #(#asUppercase #asLowercase)
+ do: [ :symbol |
+ symbol printNl.
+
+ which := printable collect: [ :each | (each perform: symbol) ].
+
+ Transcript showCr: (which copyFrom: 1 to: 47).
+ Transcript showCr: (which copyFrom: 48 to: 94).
+ Transcript nl.
+ ]
+]
--- orig/tests/classes.ok
+++ mod/tests/classes.ok
@@ -39,9 +39,6 @@ Execution begins...
returned value is Rambo
Execution begins...
-returned value is Rambo
-
-Execution begins...
returned value is Rambo new "<0>"
Execution begins...
@@ -87,12 +84,6 @@ Execution begins...
returned value is 'squeeky'
Execution begins...
-returned value is Rocky
-
-Execution begins...
-returned value is Rocky
-
-Execution begins...
returned value is 'squeeky'
Execution begins...
@@ -108,9 +99,6 @@ Execution begins...
returned value is 15
Execution begins...
-returned value is Rocky new "<0>"
-
-Execution begins...
returned value is 12
Execution begins...
@@ -144,9 +132,6 @@ Execution begins...
returned value is Rambo class
Execution begins...
-returned value is Rambo class
-
-Execution begins...
returned value is nil
Execution begins...
--- orig/tests/classes.st
+++ mod/tests/classes.st
@@ -28,23 +28,23 @@
|
======================================================================"
-^Array new: 5!
+Eval [ Array new: 5 ]
-^Array!
+Eval [ Array ]
-^Metaclass! "should be Metaclass"
-^Metaclass class!
-^Metaclass class class! "should be Metaclass, since the metaclass of
metaclass
- is a metaclass"
-^Object!
-^Object class! "should be Object class"
-^Object class class! "should be MetaClass"
+Eval [ Metaclass ] "should be Metaclass"
+Eval [ Metaclass class ]
+Eval [ Metaclass class class ] "should be Metaclass, since the metaclass of
metaclass
+ is a metaclass"
+Eval [ Object ]
+Eval [ Object class ] "should be Object class"
+Eval [ Object class class ] "should be MetaClass"
-^nil!
-^nil class!
+Eval [ nil ]
+Eval [ nil class ]
-^true!
-^true class!
+Eval [ true ]
+Eval [ true class ]
"Test creating classes at runtime
@@ -52,11 +52,13 @@
I apologize for the apparent lack of professionalism in the choice
of variable and method names here."
-Object subclass: #Rambo
+Eval [
+ Object subclass: #Rambo
instanceVariableNames: 'foo bar'
classVariableNames: 'guinea pigs'
poolDictionaries: ''
- category: ''!
+ category: ''
+]
!Rambo methodsFor: 'test'!
@@ -98,31 +100,31 @@ returnPigs
-Smalltalk at: #testVar put: (Rambo new)!
+Eval [ Smalltalk at: #testVar put: (Rambo new) ]
-^testVar foof! "should be nil (it hasn't been initialized)"
-^testVar barf! "should be nil (it hasn't been initialized)"
-^testVar returnGuinea! "should be nil (it hasn't been initialized)"
-^testVar returnPigs! "should be nil (it hasn't been initialized)"
-^Rambo new returnPigs! "should be nil"
-^Rambo new returnGuinea! "should be nil"
+Eval [ testVar foof ] "should be nil (it hasn't been
initialized)"
+Eval [ testVar barf ] "should be nil (it hasn't been
initialized)"
+Eval [ testVar returnGuinea ] "should be nil (it hasn't been
initialized)"
+Eval [ testVar returnPigs ] "should be nil (it hasn't been
initialized)"
+Eval [ Rambo new returnPigs ] "should be nil"
+Eval [ Rambo new returnGuinea ] "should be nil"
-^testVar ramboTest! "should be 10"
+Eval [ testVar ramboTest ] "should be 10"
-^testVar barf! "should now be set to 7"
+Eval [ testVar barf ] "should now be set to 7"
-^testVar foof! "should new be set to 3"
+Eval [ testVar foof ] "should new be set to 3"
-testVar initPigs: 'squeeky' and: 'junior'!
+Eval [ testVar initPigs: 'squeeky' and: 'junior' ]
"nil is returned, we just set some global
variables"
-^testVar returnPigs! "should return 'junior'"
-^testVar returnGuinea! "should return 'squeeky'"
+Eval [ testVar returnPigs ] "should return 'junior'"
+Eval [ testVar returnGuinea ] "should return 'squeeky'"
"Test that class variables really affect all instances"
-^Rambo new returnPigs! "all instances now return 'junior'"
-^Rambo new returnGuinea! "all instances now return 'squeeky'"
+Eval [ Rambo new returnPigs ] "all instances now return 'junior'"
+Eval [ Rambo new returnGuinea ] "all instances now return 'squeeky'"
@@ -160,47 +162,46 @@ juma
! !
-^Rocky new returnGuinea! "should return 'squeeky' by inheritance"
-^Rocky new returnPigs! "should return 'junior' by inheritance"
+Eval [ Rocky new returnGuinea ] "should return 'squeeky' by inheritance"
+Eval [ Rocky new returnPigs ] "should return 'junior' by inheritance"
-^Rocky new quem! "should return nil (not initialized)"
-^Rocky new juma! "should return nil (not initialized)"
+Eval [ Rocky new quem ] "should return nil (not initialized)"
+Eval [ Rocky new juma ] "should return nil (not initialized)"
"Test overriding of methods"
-testVar := Rocky new.
-^testVar ramboTest! "should return 15, and set some inst vars"
+Eval [ (testVar := Rocky new) ramboTest ] "should return 15, and
set some inst vars"
"Set the instance variables"
testVar quem: 'zoneball'.
-testVar juma: #theJumaSymbol! "should return nil"
+testVar juma: #theJumaSymbol!
-^testVar foof! "should return 12"
-^testVar barf! "should return 3"
-^testVar quem! "should return 'zoneball'"
-^testVar juma! "should return #theJumaSymbol"
+Eval [ testVar foof ] "should return 12"
+Eval [ testVar barf ] "should return 3"
+Eval [ testVar quem ] "should return 'zoneball'"
+Eval [ testVar juma ] "should return #theJumaSymbol"
"Test setting class variables from subclass"
-^(Rocky new) initPigs: 'frisky' and: 'radar'!
+Eval [ (Rocky new) initPigs: 'frisky' and: 'radar' ]
"should return instance of Rocky"
"+++ work in tests involving Dudley (Milkdud) and Speedy too+++"
"Test subclass access to class variables"
-^Rocky new returnGuinea! "should return 'frisky'"
-^Rocky new returnPigs! "should return 'radar'"
+Eval [ Rocky new returnGuinea ] "should return 'frisky'"
+Eval [ Rocky new returnPigs ] "should return 'radar'"
"Test class access to class variables that were modified from subclass"
-^Rambo new returnGuinea! "should return 'frisky'"
-^Rambo new returnPigs! "should return 'radar'"
+Eval [ Rambo new returnGuinea ] "should return 'frisky'"
+Eval [ Rambo new returnPigs ] "should return 'radar'"
"Make sure that the existing instance also sees the change in class vars"
-^testVar returnPigs! "should return 'radar'"
+Eval [ testVar returnPigs ] "should return 'radar'"
"test of class instance varialbes"
-Rambo class instanceVariableNames: 'fred'!
+Eval [ Rambo class instanceVariableNames: 'fred' ]
!Rambo class methodsFor: 'testing'!
@@ -212,8 +213,8 @@ get
^fred
! !
- ^Rambo get!
-Rambo put: 5. ^Rambo get!
- ^Rocky get!
-Rocky put: 15. ^Rambo get!
- ^Rocky get!
+Eval [ Rambo get ]
+Eval [ Rambo put: 5. Rambo get ]
+Eval [ Rocky get ]
+Eval [ Rocky put: 15. Rambo get ]
+Eval [ Rocky get ]
--- orig/tests/cobjects.ok
+++ mod/tests/cobjects.ok
@@ -73,18 +73,12 @@ Execution begins...
returned value is nil
Execution begins...
-returned value is SmallInteger
-
-Execution begins...
Marli loves Steve!!!
Marli loves Steve!!!
Marli loves Steve!!!
returned value is 3
Execution begins...
-returned value is Object
-
-Execution begins...
true
'abcabc'
'this is a test'
--- orig/tests/cobjects.st
+++ mod/tests/cobjects.st
@@ -28,84 +28,99 @@
|
======================================================================"
-| ca buf |
-ca := (CStringType arrayType: 1) new.
-buf := (CCharType arrayType: 10) new.
-buf at: 0 put: $a.
-buf at: 1 put: $s.
-buf at: 2 put: $d.
-buf at: 3 put: 0 asCharacter.
-ca at: 0 put: buf.
-^ca at: 0!
-
-| ca |
-ca := (CStringType arrayType: 1) new.
-ca at: 0 put: (CString value: 'asd').
-^ca at: 0!
-
-Smalltalk at: #CA put: nil!
-
-CA := (CStringType arrayType: 2) new.
-CA at: 0 put: (CString value: 'asd').
-CA at: 1 put: (CString value: 'dsa')!
-
-^CA at: 0!
-^CA at: 1!
-^(CA addressAt: 0) class!
-^(CA addressAt: 0) value!
-^(CA addressAt: 1) value!
-^(CA + 1) class!
-^(CA + 1) at: -1!
-^(CA + 1) at: 0!
-^(CA + 1) - CA!
-
-Smalltalk at: #CP put: nil!
-
-CP := CStringType ptrType new.
-CP value: CA.
-
-^CP value at: 0!
-^CP value at: 1!
-^(CP value addressAt: 0) class!
-^(CP value addressAt: 0) value!
-^(CP value addressAt: 1) value!
-^(CP value + 1) class!
-^(CP value + 1) at: -1!
-^(CP value + 1) at: 0!
-^(CP value + 1) - CA!
-
-
-(CPtrCType elementType: #int) new value!
-
-
-!SmallInteger methodsFor: 'C call-outs'!
-
-testAsync
- "Asynchronous vs. synchronous actually matters only when the function
- calls back to Smalltalk. But otherwise, we have no coverage of how
- the asyncCCall pragma is compiled."
- <asyncCCall: 'marli' args: #(#self)>! !
-
-3 testAsync!
-
-!Object methodsFor: 'C call-outs'!
-
-testCallin
- <cCall: 'testCallin' returning: #void args: #(#selfSmalltalk)>!
-
-testCString: cString
- <cCall: 'testCString' returning: #void args: #(#cObject)>!
-
-testCObjectPtr: cObject
- <cCall: 'testCObjectPtr' returning: #void args: #(#cObjectPtr)>! !
-
-true testCallin!
-nil testCString: (CString value: 'this is a test')!
-
-| cObject |
-cObject := CCharType new.
-nil testCObjectPtr: cObject.
-^cObject asString!
+Eval [
+ | ca buf |
+ ca := (CStringType arrayType: 1) new.
+ buf := (CCharType arrayType: 10) new.
+ buf at: 0 put: $a.
+ buf at: 1 put: $s.
+ buf at: 2 put: $d.
+ buf at: 3 put: 0 asCharacter.
+ ca at: 0 put: buf.
+ ^ca at: 0
+]
+
+Eval [
+ | ca |
+ ca := (CStringType arrayType: 1) new.
+ ca at: 0 put: (CString value: 'asd').
+ ^ca at: 0
+]
+
+Eval [ Smalltalk at: #CA put: nil ]
+
+Eval [
+ CA := (CStringType arrayType: 2) new.
+ CA at: 0 put: (CString value: 'asd').
+ CA at: 1 put: (CString value: 'dsa')
+]
+
+
+Eval [ CA at: 0 ]
+Eval [ CA at: 1 ]
+Eval [ (CA addressAt: 0) class ]
+Eval [ (CA addressAt: 0) value ]
+Eval [ (CA addressAt: 1) value ]
+Eval [ (CA + 1) class ]
+Eval [ (CA + 1) at: -1 ]
+Eval [ (CA + 1) at: 0 ]
+Eval [ (CA + 1) - CA ]
+
+Eval [ Smalltalk at: #CP put: nil ]
+
+Eval [
+ CP := CStringType ptrType new.
+ CP value: CA.
+ CP value at: 0
+]
+
+Eval [ CP value at: 1 ]
+Eval [ (CP value addressAt: 0) class ]
+Eval [ (CP value addressAt: 0) value ]
+Eval [ (CP value addressAt: 1) value ]
+Eval [ (CP value + 1) class ]
+Eval [ (CP value + 1) at: -1 ]
+Eval [ (CP value + 1) at: 0 ]
+Eval [ (CP value + 1) - CA ]
+
+
+Eval [ (CPtrCType elementType: #int) new value ]
+
+
+SmallInteger extend [
+ testAsync [
+ "Asynchronous vs. synchronous actually matters only when the function
+ calls back to Smalltalk. But otherwise, we have no coverage of how
+ the asyncCCall pragma is compiled."
+ <asyncCCall: 'marli' args: #(#self)>
+ ]
+]
+
+Eval [ 3 testAsync ]
+
+Object extend [
+
+ testCallin [
+ <cCall: 'testCallin' returning: #void args: #(#selfSmalltalk)>
+ ]
+
+ testCString: cString [
+ <cCall: 'testCString' returning: #void args: #(#cObject)>
+ ]
+
+ testCObjectPtr: cObject [
+ <cCall: 'testCObjectPtr' returning: #void args: #(#cObjectPtr)>
+ ]
+]
+
+Eval [ true testCallin ]
+Eval [ nil testCString: (CString value: 'this is a test') ]
+
+Eval [
+ cObject := CCharType new.
+ nil testCObjectPtr: cObject.
+ ^cObject asString
+]
" ### need a lot more!"
--- orig/tests/compiler.ok
+++ mod/tests/compiler.ok
@@ -1,33 +1,18 @@
-
-Execution begins...
-returned value is BugTest
-
-Execution begins...
-returned value is Object
compiler.st:40: undefined variable undefVariable referenced
Execution begins...
-returned value is BugTest
-
-Execution begins...
-returned value is String
-
-Execution begins...
returned value is Array new: 3 "<0>"
Execution begins...
returned value is 'bar'
+compiler.st:113: parse error, expected '!'
+compiler.st:116: parse error, expected keyword
Execution begins...
-returned value is BugTest class
-compiler.st:110: parse error, expected keyword
+returned value is 2
Execution begins...
returned value is 'No crashes'
-compiler.st:117: parse error, expected '.' or '!'
-
-Execution begins...
-returned value is 2
Execution begins...
a Smalltalk string:1: undefined variable a referenced
--- orig/tests/compiler.st
+++ mod/tests/compiler.st
@@ -89,9 +89,9 @@ phoneNumber
^nil
! !
-'(111) 111-1111' phoneNumber!
+Eval [ '(111) 111-1111' phoneNumber ]
-(Object compile: 'foo <category: ''bar''> ^5') methodCategory!
+Eval [ (Object compile: 'foo <category: ''bar''> ^5') methodCategory ]
"Various errors in the recursive-descent parser"
@@ -106,21 +106,25 @@ a
b
^{}!
+"The lexer crashed on this because it returned a SYMBOL_LITERAL with
+ -123 in the ival. This gives a parse error..."
+
+c
+ #-123!
+
c
<3 4>
^'foo'! !
-^BugTest c!
-
-"The lexer crashed on this because it returned a SYMBOL_LITERAL with
- -123 in the ival. This gives a parse error..."
-^#-123!
-
"... this does not."
-^#(#-123) size!
+Eval [ #(#-123) size ]
+
+Eval [ BugTest c ]
"Compiling a method should not capture the current temporaries dictionary."
-a:=42.
-Object compile: 'gotcha "shouldn''t compile!" ^a'!
-nil gotcha!
+Eval [
+ a:=42.
+ Object compile: 'gotcha "shouldn''t compile!" ^a'
+]
+Eval [ nil gotcha ]
--- orig/tests/dates.ok
+++ mod/tests/dates.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is Date class
-
-Execution begins...
1700
1707
1714
--- orig/tests/dates.st
+++ mod/tests/dates.st
@@ -29,91 +29,89 @@
======================================================================"
-!Date class methodsFor: 'testing'!
+Date class extend [
-
-inspect: aDate and: anotherDate day: dd month: mm year: yyyy
- Transcript
- show: 'newDay: ';
- print: aDate;
- show: '(';
- print: aDate days;
- show: ') <--> ';
- print: dd;
- show: '-';
- show: (self shortNameOfMonth: mm);
- show: '-';
- print: yyyy;
- show: ' <--> fromDays: ';
- print: anotherDate;
- show: '(';
- print: anotherDate days;
- show: ')';
- nl.
-
- ^self error: 'bad status'.
-!
-
-test3
- | i d |
- -100 to: 100 do: [:j |
- i _ (j * 24 * 3600) - 1. "23:59:59"
- d _ self fromSeconds: i.
- i print. Transcript space. d day print. Transcript space.
- d month print. Transcript space. d year print.
- Transcript space. d days printNl.
-
- i _ (j * 24 * 3600) . "00:00:00"
- d _ self fromSeconds: i.
- i print. Transcript space. d day print. Transcript space.
- d month print. Transcript space. d year print.
- Transcript space. d days printNl.
- ]
-!
-
-test
- | r r1 d1 k |
- "This step tests a reasonable interval of years in a small time.
- Note that 7 is prime with 4, 100, 400."
- 1700 to: 4500 by: 7 do: [:yyyy |
- (Date daysInYear: yyyy) = 366
- ifTrue: [ Transcript show: 'leap ' ].
- yyyy printNl.
- 1 to: 12 do: [:mm |
- k _ Date daysInMonthIndex: mm forYear: yyyy.
- 1 to: k do: [:dd |
- r _ Date newDay: dd monthIndex: mm year: yyyy.
- r1 _ Date fromDays: (r days).
-
- (r month = r1 month) & (r day = r1 day) &
- (r year = r1 year) & (r1 days = r days) &
- (r1 dayOfWeek = r dayOfWeek) & (r month = mm) &
- (r day = dd) & (r year = yyyy) &
- (d1 isNil or: [ (d1 - r daysFromBaseDay) ~= 1 ]) ifFalse: [
- self
- inspect: r and: r1
- day: dd month: mm year: yyyy ].
- d1 := r daysFromBaseDay.
- ].
- ]
- ].
-!
-
-test2
-
- #(1600 1699 1700 1799 1800 1899 1900 1901 1996 1997 1998 1999 2000 2001)
- do: [ :y |
- (Date newDay: 1 month: #jan year: y) print. Transcript space.
- (Date newDay: 1 month: #feb year: y) print. Transcript space.
- (Date newDay: 28 month: #feb year: y) print. Transcript space.
- (Date newDay: 1 month: #mar year: y) print. Transcript space.
- (Date newDay: 31 month: #dec year: y) print. Transcript space.
- (Date newDay: 29 month: #feb year: y) printNl
- ]
-! !
-
-
-
-Date test!
-Date test2!
-Date test3!
+ inspect: aDate and: anotherDate day: dd month: mm year: yyyy [
+ Transcript
+ show: 'newDay: ';
+ print: aDate;
+ show: '(';
+ print: aDate days;
+ show: ') <--> ';
+ print: dd;
+ show: '-';
+ show: (self shortNameOfMonth: mm);
+ show: '-';
+ print: yyyy;
+ show: ' <--> fromDays: ';
+ print: anotherDate;
+ show: '(';
+ print: anotherDate days;
+ show: ')';
+ nl.
+
+ ^self error: 'bad status'.
+ ]
+
+ test3 [
+ | i d |
+ -100 to: 100 do: [:j |
+ i _ (j * 24 * 3600) - 1. "23:59:59"
+ d _ self fromSeconds: i.
+ i print. Transcript space. d day print. Transcript space.
+ d month print. Transcript space. d year print.
+ Transcript space. d days printNl.
+
+ i _ (j * 24 * 3600) . "00:00:00"
+ d _ self fromSeconds: i.
+ i print. Transcript space. d day print. Transcript space.
+ d month print. Transcript space. d year print.
+ Transcript space. d days printNl.
+ ]
+ ]
+
+ test [
+ | r r1 d1 k |
+ "This step tests a reasonable interval of years in a small time.
+ Note that 7 is prime with 4, 100, 400."
+ 1700 to: 4500 by: 7 do: [:yyyy |
+ (Date daysInYear: yyyy) = 366
+ ifTrue: [ Transcript show: 'leap ' ].
+ yyyy printNl.
+ 1 to: 12 do: [:mm |
+ k _ Date daysInMonthIndex: mm forYear: yyyy.
+ 1 to: k do: [:dd |
+ r _ Date newDay: dd monthIndex: mm year: yyyy.
+ r1 _ Date fromDays: (r days).
+
+ (r month = r1 month) & (r day = r1 day) &
+ (r year = r1 year) & (r1 days = r days) &
+ (r1 dayOfWeek = r dayOfWeek) & (r month = mm) &
+ (r day = dd) & (r year = yyyy) &
+ (d1 isNil or: [ (d1 - r daysFromBaseDay) ~= 1 ]) ifFalse: [
+ self
+ inspect: r and: r1
+ day: dd month: mm year: yyyy ].
+ d1 := r daysFromBaseDay.
+ ].
+ ]
+ ].
+ ]
+
+ test2 [
+
+ #(1600 1699 1700 1799 1800 1899 1900 1901 1996 1997 1998 1999 2000
2001)
+ do: [ :y |
+ (Date newDay: 1 month: #jan year: y) print. Transcript space.
+ (Date newDay: 1 month: #feb year: y) print. Transcript space.
+ (Date newDay: 28 month: #feb year: y) print. Transcript space.
+ (Date newDay: 1 month: #mar year: y) print. Transcript space.
+ (Date newDay: 31 month: #dec year: y) print. Transcript space.
+ (Date newDay: 29 month: #feb year: y) printNl
+ ]
+ ]
+]
+
+Eval [ Date test ]
+Eval [ Date test2 ]
+Eval [ Date test3 ]
--- orig/tests/delays.st
+++ mod/tests/delays.st
@@ -28,15 +28,17 @@
|
======================================================================"
-| i j |
-i := 4.
-[
- [ (Delay forSeconds: 1) wait.
- i > 1 ] whileTrue: [ i := i - 1 ].
-] forkAt: Processor userInterruptPriority.
+Eval [
+ | i j |
+ i := 4.
+ [
+ [ (Delay forSeconds: 1) wait.
+ i > 1 ] whileTrue: [ i := i - 1 ].
+ ] forkAt: Processor userInterruptPriority.
-[
- (j := i) printNl.
- [ i = j ] whileTrue.
- i > 1
-] whileTrue!
+ [
+ (j := i) printNl.
+ [ i = j ] whileTrue.
+ i > 1
+ ] whileTrue
+]
--- orig/tests/except.ok
+++ mod/tests/except.ok
@@ -1,25 +1,10 @@
Execution begins...
-returned value is MyException
-
-Execution begins...
-returned value is MyException class
-
-Execution begins...
-returned value is MyException class
-
-Execution begins...
returned value is LoException
Execution begins...
returned value is HiException
Execution begins...
-returned value is HiException
-
-Execution begins...
-returned value is SmallInteger
-
-Execution begins...
Exceptions: HI=25000 / LO=25000
returned value is 'Exceptions: HI=25000 / LO=25000'
--- orig/tests/except.st
+++ mod/tests/except.st
@@ -28,60 +28,50 @@
|
======================================================================"
-Notification subclass: #MyException
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'testing'!
+Notification subclass: MyException [
+ <category: 'testing'>
-MyException class instanceVariableNames: 'count'!
+ Class protocol [
+ | count |
-!MyException class methodsFor: 'counting'!
-
-count
- ^count!
-
-increment
- count := count + 1!
-
-initialize
- count := 0! !
+ count [ ^count ]
+ increment [ count := count + 1 ]
+ initialize [ count := 0 ]
+ ]
+]
-MyException subclass: #LoException
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'testing'!
-
-MyException subclass: #HiException
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'testing'!
+MyException subclass: LoException [ ]
+Eval [ LoException initialize ]
-LoException initialize.
-HiException initialize!
+MyException subclass: HiException [ ]
+Eval [ HiException initialize ]
-!SmallInteger methodsFor: 'testing'!
-
-someFunction
- ^self hiFunction!
+SmallInteger extend [
+ someFunction [
+ ^self hiFunction
+ ]
-hiFunction
- ^[ self loFunction ] on: HiException do: [ :ex | ex class increment ]!
+ hiFunction [
+ ^[ self loFunction ] on: HiException do: [ :ex | ex class increment ]
+ ]
-loFunction
- ^[ self blowup ] on: LoException do: [ :ex | ex class increment ]!
+ loFunction [
+ ^[ self blowup ] on: LoException do: [ :ex | ex class increment ]
+ ]
-blowup
+ blowup [
^(self odd ifTrue: [ HiException ] ifFalse: [ LoException ])
- signal: self! !
-
-| n |
-n := Smalltalk arguments isEmpty
- ifTrue: [ 50000 ]
- ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-
-1 to: n do: [ :each | each someFunction ].
-('Exceptions: HI=%1 / LO=%2'
- bindWith: HiException count with: LoException count) displayNl!
+ signal: self
+ ]
+]
+
+Eval [
+ | n |
+ n := Smalltalk arguments isEmpty
+ ifTrue: [ 50000 ]
+ ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
+
+ 1 to: n do: [ :each | each someFunction ].
+ ('Exceptions: HI=%1 / LO=%2'
+ bindWith: HiException count with: LoException count) displayNl
+]
--- orig/tests/exceptions.st
+++ mod/tests/exceptions.st
@@ -27,8 +27,11 @@
|
======================================================================"
-Smalltalk at: #TestException put: ExAll newChild!
+Eval [
+ Smalltalk at: #TestException put: ExAll newChild
+]
+Eval [
[
Transcript cr; show: 'testResume...'.
TestException signal.
@@ -37,9 +40,10 @@ Smalltalk at: #TestException put: ExAll
on: TestException
do: [:excp | excp resume ].
- Transcript cr!
-
+ Transcript cr
+]
+Eval [
[
Transcript cr; show: 'testReturn...'.
TestException signal.
@@ -50,8 +54,10 @@ Smalltalk at: #TestException put: ExAll
Transcript show: 'passed if nothing follows on this line'.
excp return ].
- Transcript cr!
+ Transcript cr
+]
+Eval [
[
Transcript cr; show: 'testPass...'.
[
@@ -66,92 +72,110 @@ Smalltalk at: #TestException put: ExAll
Transcript show: 'passed if nothing follows on this line'.
excp return].
- Transcript cr!
+ Transcript cr
+]
+Eval [
[ Transcript cr; show: 'testEnsure...'.
self error: ' Ignore this error']
- ensure: [Transcript show: 'passed'; cr]!
+ ensure: [Transcript show: 'passed'; cr]
+]
-Smalltalk at: #Ok put: 0!
+Eval [
+ Smalltalk at: #Ok put: 0
+]
-"TODO: turn this into an eval!!"
-[
+Eval [
[ self error: ' Ignore this error']
ifCurtailed: [ Ok := Ok + 1 ].
Ok := Ok + 2
-] value!
+]
+Eval [
Transcript cr; show: 'testIfCurtailed...'.
Ok = 1 ifFalse: [
Ok >= 2 ifTrue: [ Transcript show: 'control returned'; cr ].
Ok even ifTrue: [ Transcript show: 'ifCurtailed not executed'; cr ].
^self
].
- Transcript show: 'passed'; cr!
+ Transcript show: 'passed'; cr
+]
+Eval [
| r |
Ok := 0.
r := [#( 1 2 ) size] ensure: [Ok := Ok + 1].
- ^(r = 2) & (Ok = 1)!
+ ^(r = 2) & (Ok = 1)
+]
+Eval [
Ok := 0.
[ [#( 1 2 ) siz] ensure: [ Ok := Ok + 1 ].
] on: MessageNotUnderstood do: [ :mnu | mnu return ].
- ^Ok = 1!
+ ^Ok = 1
+]
+Eval [
Ok := 0.
- [#( 1 2 ) siz] ensure: [ Ok := Ok + 1 ]!
- ^Ok = 1!
+ [#( 1 2 ) siz] ensure: [ Ok := Ok + 1 ]
+]
+Eval [ ^Ok = 1 ]
+Eval [
Ok := 0.
[ [Error signal] ensure: [ Ok := Ok + 1 ].
] on: Error do: [ :error | error return ].
- ^Ok = 1!
+ ^Ok = 1
+]
+Eval [
Ok := 0.
- [Error signal] ensure: [ Ok := Ok + 1 ]!
- ^Ok = 1!
+ [Error signal] ensure: [ Ok := Ok + 1 ]
+]
+Eval [ ^Ok = 1 ]
+Eval [
| tmp |
Ok := 0.
[tmp := [Notification signal. Ok = 0] ensure: [ Ok := Ok + 1 ].
] on: Notification do: [ :notification | notification resume ].
- ^tmp!
+ ^tmp
+]
-Smalltalk removeKey: #Ok!
+Eval [ Smalltalk removeKey: #Ok ]
"Do some torture testing on #ensure: and #ifCurtailed:"
-^[ #block printNl ] ensure: [ #outer printNl ]!
-^[ #block printNl ] ensure: [ ^#outer printNl ]!
-^[ [ #block printNl ] ensure: [ #inner printNl ] ] ensure: [ #outer printNl ]!
-^[ [ #block printNl ] ensure: [ #inner printNl ] ] ensure: [ ^#outer printNl ]!
-^[ [ #block printNl ] ensure: [ ^#inner printNl ] ] ensure: [ #outer printNl ]!
-^[ [ #block printNl ] ensure: [ ^#inner printNl ] ] ensure: [ ^#outer printNl
]!
-
-^[ #block printNl ] ifCurtailed: [ #outer printNl ]!
-^[ #block printNl ] ifCurtailed: [ ^#outer printNl ]!
-^[ [ #block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [ #outer
printNl ]!
-^[ [ #block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [ ^#outer
printNl ]!
-^[ [ #block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [ #outer
printNl ]!
-^[ [ #block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
^#outer printNl ]!
-
-
-^[ ^#block printNl ] ifCurtailed: [ #outer printNl ]!
-^[ ^#block printNl ] ifCurtailed: [ ^#outer printNl ]!
-^[ [ ^#block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [ #outer
printNl ]!
-^[ [ ^#block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [
^#outer printNl ]!
-^[ [ ^#block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
#outer printNl ]!
-^[ [ ^#block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
^#outer printNl ]!
+Eval [ [ #block printNl ] ensure: [ #outer printNl ] ]
+Eval [ [ #block printNl ] ensure: [ ^#outer printNl ] ]
+Eval [ [ [ #block printNl ] ensure: [ #inner printNl ] ] ensure: [ #outer
printNl ] ]
+Eval [ [ [ #block printNl ] ensure: [ #inner printNl ] ] ensure: [ ^#outer
printNl ] ]
+Eval [ [ [ #block printNl ] ensure: [ ^#inner printNl ] ] ensure: [ #outer
printNl ] ]
+Eval [ [ [ #block printNl ] ensure: [ ^#inner printNl ] ] ensure: [ ^#outer
printNl ] ]
+
+Eval [ [ #block printNl ] ifCurtailed: [ #outer printNl ] ]
+Eval [ [ #block printNl ] ifCurtailed: [ ^#outer printNl ] ]
+Eval [ [ [ #block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [
#outer printNl ] ]
+Eval [ [ [ #block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [
^#outer printNl ] ]
+Eval [ [ [ #block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
#outer printNl ] ]
+Eval [ [ [ #block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
^#outer printNl ] ]
+
+
+Eval [ [ ^#block printNl ] ifCurtailed: [ #outer printNl ] ]
+Eval [ [ ^#block printNl ] ifCurtailed: [ ^#outer printNl ] ]
+Eval [ [ [ ^#block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [
#outer printNl ] ]
+Eval [ [ [ ^#block printNl ] ifCurtailed: [ #inner printNl ] ] ifCurtailed: [
^#outer printNl ] ]
+Eval [ [ [ ^#block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
#outer printNl ] ]
+Eval [ [ [ ^#block printNl ] ifCurtailed: [ ^#inner printNl ] ] ifCurtailed: [
^#outer printNl ] ]
"used to go in an infinite loop"
-[ self halt ] on: 1 do: [ :ex | 'blah' printNl ]!
+Eval [ [ self halt ] on: 1 do: [ :ex | 'blah' printNl ] ]
"Test error handling within a process."
-[^'test'] fork!
+Eval [ [^'test'] fork ]
"Test error handling within a process."
-[self error: 'test'] fork!
+Eval [ [self error: 'test'] fork ]
--- orig/tests/fibo.ok
+++ mod/tests/fibo.ok
@@ -1,7 +1,4 @@
Execution begins...
-returned value is SmallInteger
-
-Execution begins...
34
returned value is 34
--- orig/tests/fibo.st
+++ mod/tests/fibo.st
@@ -28,15 +28,17 @@
|
======================================================================"
-!SmallInteger methodsFor: 'testing'!
+SmallInteger extend [
+ fib [
+ ^self < 2 ifTrue: [ 1 ] ifFalse: [ (self - 2) fib + (self - 1) fib ]
+ ]
+]
-fib
- ^self < 2 ifTrue: [ 1 ] ifFalse: [ (self - 2) fib + (self - 1) fib ]! !
-
-| n |
-
-n := Smalltalk arguments isEmpty
+Eval [
+ | n |
+ n := Smalltalk arguments isEmpty
ifTrue: [ 8 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-n fib printNl!
+ n fib printNl
+]
--- orig/tests/fileext.ok
+++ mod/tests/fileext.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is Object
-
-Execution begins...
true
true
true
--- orig/tests/fileext.st
+++ mod/tests/fileext.st
@@ -27,49 +27,53 @@
|
======================================================================"
-!Object methodsFor: 'testing' !
+Object extend [
-testCaseData
- | extensions |
- extensions := OrderedCollection new.
- extensions
- add: '' -> '';
- add: '.' -> '';
- add: '/' -> '';
- add: 'text' -> '';
- add: 'text.' -> '.';
- add: '.text' -> '';
- add: 'text/' -> '';
- add: '/text' -> '';
- add: '/.' -> '';
- add: './' -> '';
- add: 'file.ext' -> '.ext';
- add: 'file.ext.' -> '.';
- add: '.file.ext' -> '.ext';
- add: 'file.ext/' -> '';
- add: '/file.ext' -> '.ext';
- add: '/.file.ext' -> '.ext';
- add: './file.ext' -> '.ext';
- add: 'dir/file' -> '';
- add: 'dir/file.' -> '.';
- add: 'dir/.file' -> '';
- add: 'dir/file.ext' -> '.ext';
- add: 'dir/file.ext.' -> '.'.
+ testCaseData [
+ | extensions |
+ extensions := OrderedCollection new.
+ extensions
+ add: '' -> '';
+ add: '.' -> '';
+ add: '/' -> '';
+ add: 'text' -> '';
+ add: 'text.' -> '.';
+ add: '.text' -> '';
+ add: 'text/' -> '';
+ add: '/text' -> '';
+ add: '/.' -> '';
+ add: './' -> '';
+ add: 'file.ext' -> '.ext';
+ add: 'file.ext.' -> '.';
+ add: '.file.ext' -> '.ext';
+ add: 'file.ext/' -> '';
+ add: '/file.ext' -> '.ext';
+ add: '/.file.ext' -> '.ext';
+ add: './file.ext' -> '.ext';
+ add: 'dir/file' -> '';
+ add: 'dir/file.' -> '.';
+ add: 'dir/.file' -> '';
+ add: 'dir/file.ext' -> '.ext';
+ add: 'dir/file.ext.' -> '.'.
+
+ ^extensions
+ ]
+
+ testExtensionFor [
+
+ self testCaseData do: [:each |
+ [(File extensionFor: each key) = each value] value printNl ]
+ ]
+
+ testStripExtensionFrom [
+
+ "(File stripExtensionFrom: aString),
+ (File extensionFor: aString) = aString"
+
+ self testCaseData do: [:each |
+ [(File stripExtensionFrom: each key),
+ (File extensionFor: each key) = each key] value printNl ]
+ ]
+]
- ^extensions!
-
-testExtensionFor
-
- self testCaseData do: [:each |
- [(File extensionFor: each key) = each value] value printNl ]!
-
-testStripExtensionFrom
-
- "(File stripExtensionFrom: aString),
- (File extensionFor: aString) = aString"
-
- self testCaseData do: [:each |
- [(File stripExtensionFrom: each key),
- (File extensionFor: each key) = each key] value printNl ]! !
-
-Object new testExtensionFor; testStripExtensionFrom!
+Eval [ Object new testExtensionFor; testStripExtensionFrom ]
--- orig/tests/floatmath.ok
+++ mod/tests/floatmath.ok
@@ -1,5 +1,8 @@
Execution begins...
+returned value is ObjectMemory
+
+Execution begins...
returned value is 3.10000
Execution begins...
@@ -201,9 +204,6 @@ Execution begins...
returned value is Array new: 2 "<0>"
Execution begins...
-returned value is Float
-
-Execution begins...
true->10000000000000000.0
returned value is 1.00000d+16
@@ -260,9 +260,6 @@ true->0.554700196225229
returned value is 0.554700
Execution begins...
-returned value is Float class
-
-Execution begins...
true
true
true
--- orig/tests/floatmath.st
+++ mod/tests/floatmath.st
@@ -28,209 +28,221 @@
|
======================================================================"
-(1 to: 500000) collect: [ :each |
- RegressionTesting ifFalse: [
- each \\ 1000 = 0 ifTrue: [ each basicPrint. Character nl basicPrint ]
+Eval [
+ (1 to: 500000) collect: [ :each |
+ RegressionTesting ifFalse: [
+ each \\ 1000 = 0 ifTrue: [ each basicPrint. Character nl basicPrint
]
+ ].
+ -1.0 negated
].
- -1.0 negated
-].
-ObjectMemory globalGarbageCollect.
+ ObjectMemory globalGarbageCollect
+]
-^3.1!
+Eval [ 3.1 ]
-^3.45!
+Eval [ 3.45 ]
-^3.0e4!
+Eval [ 3.0e4 ]
-^3.45e4!
+Eval [ 3.45e4 ]
-^3.4 + 4.3!
+Eval [ 3.4 + 4.3 ]
-^-5.5 - 3.12!
+Eval [ -5.5 - 3.12 ]
-^5.6 < 5.5!
-^5.5 < 5.6!
+Eval [ 5.6 < 5.5 ]
+Eval [ 5.5 < 5.6 ]
-^5.6 > 5.5!
-^5.5 > 5.6!
+Eval [ 5.6 > 5.5 ]
+Eval [ 5.5 > 5.6 ]
-^3.4 <= 3.4!
-^3.6 >= 2.5!
+Eval [ 3.4 <= 3.4 ]
+Eval [ 3.6 >= 2.5 ]
-^3.12345 = 3.12345!
+Eval [ 3.12345 = 3.12345 ]
-^4.5 ~= 5.67!
+Eval [ 4.5 ~= 5.67 ]
-^4.5 * 0.0004!
+Eval [ 4.5 * 0.0004 ]
-^4.5 / 0.0004!
+Eval [ 4.5 / 0.0004 ]
-^3.14159 truncated!
+Eval [ 3.14159 truncated ]
-^3.1415926535 fractionPart!
+Eval [ 3.1415926535 fractionPart ]
-^4523.234 exponent!
+Eval [ 4523.234 exponent ]
-^45.0 timesTwoPower: 4!
-^45.0 timesTwoPower: -4!
+Eval [ 45.0 timesTwoPower: 4 ]
+Eval [ 45.0 timesTwoPower: -4 ]
-^FloatD infinity!
-^FloatD infinity printString!
+Eval [ FloatD infinity ]
+Eval [ FloatD infinity printString ]
-^FloatD negativeInfinity!
-^FloatD negativeInfinity printString!
+Eval [ FloatD negativeInfinity ]
+Eval [ FloatD negativeInfinity printString ]
-^FloatD nan!
-^FloatD nan printString!
+Eval [ FloatD nan ]
+Eval [ FloatD nan printString ]
-^FloatD infinity reciprocal printString!
-^FloatD negativeInfinity reciprocal printString!
+Eval [ FloatD infinity reciprocal printString ]
+Eval [ FloatD negativeInfinity reciprocal printString ]
-0.0 positive!
-(0.0 * -1) positive!
+Eval [ 0.0 positive ]
+Eval [ (0.0 * -1) positive ]
-^FloatD nan min: FloatD nan!
-^FloatD nan min: 5.0!
-^5.0 min: FloatD nan!
-^5.0 min: 7.0!
-^7.0 min: 5.0!
-^7.0 min: 7.0!
-^0.0 min: 0.0!
-^0.0 min: 0.0 * -1!
-^0.0 * -1 min: 0.0!
-^0.0 * -1 min: 0.0 * -1!
+Eval [ FloatD nan min: FloatD nan ]
+Eval [ FloatD nan min: 5.0 ]
+Eval [ 5.0 min: FloatD nan ]
+Eval [ 5.0 min: 7.0 ]
+Eval [ 7.0 min: 5.0 ]
+Eval [ 7.0 min: 7.0 ]
+Eval [ 0.0 min: 0.0 ]
+Eval [ 0.0 min: 0.0 * -1 ]
+Eval [ 0.0 * -1 min: 0.0 ]
+Eval [ 0.0 * -1 min: 0.0 * -1 ]
-^FloatD nan max: FloatD nan!
-^FloatD nan max: 5.0!
-^5.0 max: FloatD nan!
-^5.0 max: 7.0!
-^7.0 max: 5.0!
-^7.0 max: 7.0!
-^0.0 max: 0.0!
-^0.0 max: 0.0 * -1!
-^0.0 * -1 max: 0.0!
-^0.0 * -1 max: 0.0 * -1!
+Eval [ FloatD nan max: FloatD nan ]
+Eval [ FloatD nan max: 5.0 ]
+Eval [ 5.0 max: FloatD nan ]
+Eval [ 5.0 max: 7.0 ]
+Eval [ 7.0 max: 5.0 ]
+Eval [ 7.0 max: 7.0 ]
+Eval [ 0.0 max: 0.0 ]
+Eval [ 0.0 max: 0.0 * -1 ]
+Eval [ 0.0 * -1 max: 0.0 ]
+Eval [ 0.0 * -1 max: 0.0 * -1 ]
" ### need more tests"
-^(( 0.6 \\ 1) * 10) rounded == ( 6 \\ 10)!
-^(( 0.6 \\ -1) * 10) rounded == ( 6 \\ -10)!
-^((-0.6 \\ 1) * 10) rounded == (-6 \\ 10)!
-^((-0.6 \\ -1) * 10) rounded == (-6 \\ -10)!
-^(( 0.4 \\ 1) * 10) rounded == ( 4 \\ 10)!
-^(( 0.4 \\ -1) * 10) rounded == ( 4 \\ -10)!
-^((-0.4 \\ 1) * 10) rounded == (-4 \\ 10)!
-^((-0.4 \\ -1) * 10) rounded == (-4 \\ -10)!
+Eval [ (( 0.6 \\ 1) * 10) rounded == ( 6 \\ 10) ]
+Eval [ (( 0.6 \\ -1) * 10) rounded == ( 6 \\ -10) ]
+Eval [ ((-0.6 \\ 1) * 10) rounded == (-6 \\ 10) ]
+Eval [ ((-0.6 \\ -1) * 10) rounded == (-6 \\ -10) ]
+Eval [ (( 0.4 \\ 1) * 10) rounded == ( 4 \\ 10) ]
+Eval [ (( 0.4 \\ -1) * 10) rounded == ( 4 \\ -10) ]
+Eval [ ((-0.4 \\ 1) * 10) rounded == (-4 \\ 10) ]
+Eval [ ((-0.4 \\ -1) * 10) rounded == (-4 \\ -10) ]
" Fun with signed zeros"
+Eval [
#(( -0.0d -0.0d) (-0.0d 0.0d) (0.0d -0.0d) (0.0d 0.0d)) do: [ :x ||a b|
a := x first. b := x last.
{ a. b. a negated + b. b - a.
((a negated + b) = (b - a)).
a + b negated. a - b.
- ((a + b negated) = (a - b)) } printNl ]!
-
+ ((a + b negated) = (a - b)) } printNl ]
+]
+Eval [
#(( -0.0e -0.0e) (-0.0e 0.0e) (0.0e -0.0e) (0.0e 0.0e)) do: [ :x ||a b|
a := x first. b := x last.
{ a. b. a negated + b. b - a.
((a negated + b) = (b - a)).
a + b negated. a - b.
- ((a + b negated) = (a - b)) } printNl ]!
+ ((a + b negated) = (a - b)) } printNl ]
+]
+
"This is less strict because it behaves differently on different long double
formats."
+Eval [
#(( -0.0q -0.0q) (0.0q 0.0q)) do: [ :x ||a b|
a := x first. b := x last.
{ a. b. a negated + b. b - a.
((a negated + b) = (b - a)).
a + b negated. a - b.
- ((a + b negated) = (a - b)) } printNl ]!
+ ((a + b negated) = (a - b)) } printNl ]
+]
+Eval [
#((-0.0q 0.0q) (0.0q -0.0q)) do: [ :x ||a b|
a := x first. b := x last.
{ a. b.
((b - a) negated = (a - b)).
((a negated + b) = (b - a)).
- ((a + b negated) = (a - b)) } printNl ]!
-
+ ((a + b negated) = (a - b)) } printNl ]
+]
"Fun with printing"
-!Float methodsFor: 'testing'!
-
-test
- (((Behavior evaluate: self printString) = self) -> self) printNl.
-! !
-
-1d16 test!
-1e16 test!
-1.2345d16 test!
-1.2345e16 test!
-1.25 test!
-10.0 test!
-(20 - 2.2325251) test!
-0.12345 test!
-0.12345d-8 test!
-0.12345e-8 test!
-0.83205029433784 test!
-0.832050294337844 test!
-0.55470019622523 test!
-0.554700196225229 test!
+Float extend [
+ test [
+ (((Behavior evaluate: self printString) = self) -> self) printNl
+ ]
+]
+
+Eval [ 1d16 test ]
+Eval [ 1e16 test ]
+Eval [ 1.2345d16 test ]
+Eval [ 1.2345e16 test ]
+Eval [ 1.25 test ]
+Eval [ 10.0 test ]
+Eval [ (20 - 2.2325251) test ]
+Eval [ 0.12345 test ]
+Eval [ 0.12345d-8 test ]
+Eval [ 0.12345e-8 test ]
+Eval [ 0.83205029433784 test ]
+Eval [ 0.832050294337844 test ]
+Eval [ 0.55470019622523 test ]
+Eval [ 0.554700196225229 test ]
"Fun with rounding"
-!Float class methodsFor: 'testing'!
-
-assert: aBoolean
- aBoolean ifFalse: [ self halt ] ifTrue: [ aBoolean printNl ]!
+Float class extend [
-test
- | p |
- p := 1 bitShift: self precision - 1.
- self assert: (self coerce: p+0+(1/4)) asExactFraction = (p+0).
- self assert: (self coerce: p+0+(1/2)) asExactFraction = (p+0).
- self assert: (self coerce: p+0+(3/4)) asExactFraction = (p+1).
- self assert: (self coerce: p+1+(1/4)) asExactFraction = (p+1).
- self assert: (self coerce: p+1+(1/2)) asExactFraction = (p+2).
- self assert: (self coerce: p+1+(3/4)) asExactFraction = (p+2).
-
- self assert: ((self emin - self precision - 1 to: self emax - 1)
allSatisfy: [:i |
- p := (self coerce: 1) timesTwoPower: i.
- (self coerce: p asExactFraction) = p]).
-
- self assert: ((1 to: 1 + self precision - self emin) allSatisfy: [:i |
- p := (self coerce: 1) timesTwoPower: i negated.
- (self coerce: (1 bitShift: i) reciprocal negated) = p negated]).
-
- "check for negative zero"
- p := 1 bitShift: 1 + self precision - self emin.
- self assert: (self coerce: p reciprocal) positive.
- self assert: (self coerce: p reciprocal negated) negative.
-
- "check for infinity"
- p := 1 bitShift: self emax + 1.
- self assert: (self coerce: p) = self infinity.
- self assert: (self coerce: p negated) = self negativeInfinity.
-
- p := 1 bitShift: 1 + self precision - self emin.
- self assert: (self coerce: p / 3) = self infinity.
- self assert: (self coerce: p / -3) = self negativeInfinity.
-
- "check for non infinity/nan"
- p := 1 bitShift: self emax + 1.
- self assert: (self coerce: p / 3) isFinite.
- self assert: (self coerce: p / -3) isFinite.
-
- p := 1 bitShift: 1 + self precision - self emin.
- self assert: (self coerce: 3 / p) isFinite.
- self assert: (self coerce: -3 / p) isFinite! !
+ assert: aBoolean [
+ aBoolean ifFalse: [ self halt ] ifTrue: [ aBoolean printNl ]
+ ]
+
+ test [
+ | p |
+ p := 1 bitShift: self precision - 1.
+ self assert: (self coerce: p+0+(1/4)) asExactFraction = (p+0).
+ self assert: (self coerce: p+0+(1/2)) asExactFraction = (p+0).
+ self assert: (self coerce: p+0+(3/4)) asExactFraction = (p+1).
+ self assert: (self coerce: p+1+(1/4)) asExactFraction = (p+1).
+ self assert: (self coerce: p+1+(1/2)) asExactFraction = (p+2).
+ self assert: (self coerce: p+1+(3/4)) asExactFraction = (p+2).
+
+ self assert: ((self emin - self precision - 1 to: self emax - 1)
allSatisfy: [:i |
+ p := (self coerce: 1) timesTwoPower: i.
+ (self coerce: p asExactFraction) = p]).
+
+ self assert: ((1 to: 1 + self precision - self emin) allSatisfy: [:i |
+ p := (self coerce: 1) timesTwoPower: i negated.
+ (self coerce: (1 bitShift: i) reciprocal negated) = p negated]).
+
+ "check for negative zero"
+ p := 1 bitShift: 1 + self precision - self emin.
+ self assert: (self coerce: p reciprocal) positive.
+ self assert: (self coerce: p reciprocal negated) negative.
+
+ "check for infinity"
+ p := 1 bitShift: self emax + 1.
+ self assert: (self coerce: p) = self infinity.
+ self assert: (self coerce: p negated) = self negativeInfinity.
+
+ p := 1 bitShift: 1 + self precision - self emin.
+ self assert: (self coerce: p / 3) = self infinity.
+ self assert: (self coerce: p / -3) = self negativeInfinity.
+
+ "check for non infinity/nan"
+ p := 1 bitShift: self emax + 1.
+ self assert: (self coerce: p / 3) isFinite.
+ self assert: (self coerce: p / -3) isFinite.
+
+ p := 1 bitShift: 1 + self precision - self emin.
+ self assert: (self coerce: 3 / p) isFinite.
+ self assert: (self coerce: -3 / p) isFinite
+ ]
+]
-FloatD test!
-FloatE test!
+Eval [ FloatD test ]
+Eval [ FloatE test ]
--- orig/tests/geometry.ok
+++ mod/tests/geometry.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is Rectangle
-
-Execution begins...
'p1 = 'address@hidden
'p2 = 'address@hidden
returned value is Point new "<0>"
--- orig/tests/geometry.st
+++ mod/tests/geometry.st
@@ -30,27 +30,29 @@
|
======================================================================"
-!Rectangle methodsFor: 'testing'!
+Rectangle extend [
-myAreasOutside: a
- | ans |
- ans := self areasOutside: a.
- ans := ans asSortedCollection: [ :x :y | x printString < y printString ].
- ^ans asArray! !
+ myAreasOutside: a [
+ | ans |
+ ans := self areasOutside: a.
+ ans := ans asSortedCollection: [ :x :y | x printString < y printString
].
+ ^ans asArray
+ ]
+]
"Creation methods and printing"
-| p1 p2 |
+Eval [
p1 := Point x: 123 y: 456.
p2 := address@hidden
'p1 = ' print.
p1 printNl.
'p2 = ' print.
p2 printNl.
-!
+]
"accessing"
-| p |
+Eval [
p := address@hidden
'(p x) = ' print.
(p x) printNl.
@@ -62,10 +64,10 @@ myAreasOutside: a
p y: 654.
'p = ' print.
p printNl.
-!
+]
"comparing"
-| A B C |
+Eval [
A := address@hidden
B := address@hidden
C := address@hidden
@@ -81,11 +83,11 @@ myAreasOutside: a
(A max: B) printNl.
'A min: B = ' print.
(A min: B) printNl.
-!
+]
"arithmetic"
-| A B C D|
+Eval [
A := address@hidden
B := address@hidden
C := address@hidden
@@ -108,11 +110,11 @@ myAreasOutside: a
((address@hidden) rounded) printNl.
'D truncateTo: 50 = ' print.
(D truncateTo: 50) printNl.
-!
+]
"point functions"
-| A B C D |
+Eval [
A := address@hidden
B := address@hidden
C := address@hidden
@@ -129,13 +131,13 @@ myAreasOutside: a
(C truncatedGrid: D) printNl.
'address@hidden transpose = ' print.
((address@hidden) transpose) printNl.
-!
+]
"RECTANGLES--------------------------"
"creation and printing"
-| A |
+Eval [
'5 lines should be the same: A = address@hidden corner: address@hidden'
printNl.
A := Rectangle left: 100 right: 200 top: 100 bottom: 200.
'A = ' print.
@@ -151,10 +153,11 @@ myAreasOutside: a
A printNl.
A := (address@hidden) extent: address@hidden
'A = ' print.
- A printNl!
+ A printNl
+]
"accessing"
-| A |
+Eval [
A := Rectangle origin: address@hidden extent: address@hidden
'A = ' print.
A printNl.
@@ -171,10 +174,11 @@ myAreasOutside: a
'extent = ' print.
(A extent) printNl.
'area = ' print.
- (A area) printNl!
+ (A area) printNl
+]
"rectangle functions"
-| A B C D |
+Eval [
A := address@hidden corner: address@hidden
B := address@hidden corner: address@hidden
C := address@hidden corner: address@hidden
@@ -187,23 +191,26 @@ myAreasOutside: a
(D myAreasOutside: B) printNl.
(C expandBy: 10) printNl.
(C insetBy: address@hidden) printNl.
- (B merge: C) printNl!
+ (B merge: C) printNl
+]
"testing"
-| A B C |
+Eval [
A := address@hidden corner: address@hidden
B := address@hidden corner: address@hidden
C := address@hidden corner: address@hidden
(A contains: B) printNl.
(C containsPoint: address@hidden) printNl.
- (A intersects: B) printNl!
+ (A intersects: B) printNl
+]
"truncation and round off and transforming"
-| A B C |
+Eval [
A := address@hidden corner: address@hidden
B := address@hidden corner: address@hidden
C := address@hidden corner: address@hidden
(A moveBy: address@hidden) printNl.
(A moveTo: address@hidden) printNl.
(A scaleBy: 2) printNl.
- (A translateBy: -100) printNl!
+ (A translateBy: -100) printNl
+]
--- orig/tests/getopt.ok
+++ mod/tests/getopt.ok
@@ -1,11 +1,5 @@
Execution begins...
-returned value is Getopt class
-
-Execution begins...
-returned value is Getopt
-
-Execution begins...
SortedCollection ()
$B->#noArg
returned value is Getopt new "<0>"
--- orig/tests/getopt.st
+++ mod/tests/getopt.st
@@ -30,43 +30,45 @@
|
======================================================================"
-!Getopt class methodsFor: 'private-testing'!
+Getopt extend [
+ Class protocol [
+ test: args with: pattern [
+ args do: [ :each |
+ self
+ parse: each subStrings
+ with: pattern
+ do: [ :x :y | (x->y) printNl ]
+ ifError: [ (each->'error') displayNl ].
+ Transcript nl ]
+ ]
+ ]
-test: args with: pattern
- args do: [ :each |
- self
- parse: each subStrings
- with: pattern
- do: [ :x :y | (x->y) printNl ]
- ifError: [ (each->'error') displayNl ].
- Transcript nl ]! !
+ testParsing: p [
+ self parsePattern: p.
+ prefixes asSortedCollection printNl.
+ (options keys asSortedCollection: [ :a :b | a asString < b asString ])
+ do: [ :k | (options associationAt: k) printNl ]
+ ]
+]
-!Getopt methodsFor: 'private-testing'!
-
-testParsing: p
- self parsePattern: p.
- prefixes asSortedCollection printNl.
- (options keys asSortedCollection: [ :a :b | a asString < b asString ])
- do: [ :k | (options associationAt: k) printNl ]! !
-
-Getopt new testParsing: '-B'!
-Getopt new testParsing: '--long'!
-Getopt new testParsing: '--longish --longer'!
-Getopt new testParsing: '--long --longer'!
-Getopt new testParsing: '-B:'!
-Getopt new testParsing: '-B::'!
-Getopt new testParsing: '-a|-b'!
-Getopt new testParsing: '-a|--long'!
-Getopt new testParsing: '-a|--very-long|--long'!
-Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a -b'!
-Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a: -b'!
-Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a:: -b'!
-Getopt test: #('--longish' '--longer' '--longi' '--longe' '--lo' '-longer')
with: '--longish --longer'!
-Getopt test: #('--lo' '--long' '--longe' '--longer') with: '--long --longer'!
-Getopt test: #('--noarg' '--mandatory' '--mandatory foo' '--mandatory='
'--mandatory=foo' '--optional' '--optional foo') with: '--noarg --mandatory:
--optional::'!
-Getopt test: #('-a' '-b') with: '-a|-b'!
-Getopt test: #('--long' '-b') with: '-b|--long'!
-Getopt test: #('--long=x' '-bx') with: '-b|--long:'!
-Getopt test: #('-b' '--long' '--very-long') with: '-b|--very-long|--long'!
-Getopt test: #('--long=x' '--very-long x' '-bx') with:
'-b|--very-long|--long:'!
-Getopt test: #('-b -- -b' '-- -b' '-- -b -b') with: '-b'!
+Eval [ Getopt new testParsing: '-B' ]
+Eval [ Getopt new testParsing: '--long' ]
+Eval [ Getopt new testParsing: '--longish --longer' ]
+Eval [ Getopt new testParsing: '--long --longer' ]
+Eval [ Getopt new testParsing: '-B:' ]
+Eval [ Getopt new testParsing: '-B::' ]
+Eval [ Getopt new testParsing: '-a|-b' ]
+Eval [ Getopt new testParsing: '-a|--long' ]
+Eval [ Getopt new testParsing: '-a|--very-long|--long' ]
+Eval [ Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a -b' ]
+Eval [ Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a: -b' ]
+Eval [ Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a:: -b' ]
+Eval [ Getopt test: #('--longish' '--longer' '--longi' '--longe' '--lo'
'-longer') with: '--longish --longer' ]
+Eval [ Getopt test: #('--lo' '--long' '--longe' '--longer') with: '--long
--longer' ]
+Eval [ Getopt test: #('--noarg' '--mandatory' '--mandatory foo' '--mandatory='
'--mandatory=foo' '--optional' '--optional foo') with: '--noarg --mandatory:
--optional::' ]
+Eval [ Getopt test: #('-a' '-b') with: '-a|-b' ]
+Eval [ Getopt test: #('--long' '-b') with: '-b|--long' ]
+Eval [ Getopt test: #('--long=x' '-bx') with: '-b|--long:' ]
+Eval [ Getopt test: #('-b' '--long' '--very-long') with:
'-b|--very-long|--long' ]
+Eval [ Getopt test: #('--long=x' '--very-long x' '-bx') with:
'-b|--very-long|--long:' ]
+Eval [ Getopt test: #('-b -- -b' '-- -b' '-- -b -b') with: '-b' ]
--- orig/tests/hash.st
+++ mod/tests/hash.st
@@ -28,20 +28,20 @@
|
======================================================================"
-| n c hash |
-
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 20000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-hash := LookupTable new: n * 2.
-1 to: n do: [ :each |
+ hash := LookupTable new: n * 2.
+ 1 to: n do: [ :each |
hash at: (each printString: 16) put: 1.
-].
+ ].
-c := 0.
-n to: 1 by: -1 do: [ :each |
+ c := 0.
+ n to: 1 by: -1 do: [ :each |
(hash includesKey: each printString) ifTrue: [ c := c + 1].
-].
+ ].
-c printNl!
+ c printNl
+]
--- orig/tests/hash2.st
+++ mod/tests/hash2.st
@@ -28,23 +28,23 @@
|
======================================================================"
-| hash1 hash2 i n |
-
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 10 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-hash1 := LookupTable new: 15000.
-0 to: 9999 do: [ :each |
+ hash1 := LookupTable new: 15000.
+ 0 to: 9999 do: [ :each |
hash1 at: 'foo_', each printString put: each.
-].
+ ].
-hash2 := LookupTable new: 15000.
-n timesRepeat: [
- hash1 keysAndValuesDo: [ :k :v |
- hash2 at: k put: (hash2 at: k ifAbsent: [0]) + v ]].
+ hash2 := LookupTable new: 15000.
+ n timesRepeat: [
+ hash1 keysAndValuesDo: [ :k :v |
+ hash2 at: k put: (hash2 at: k ifAbsent: [0]) + v ]].
-('%1 %2 %3 %4' bindWith: (hash1 at: 'foo_1')
+ ('%1 %2 %3 %4' bindWith: (hash1 at: 'foo_1')
with: (hash1 at: 'foo_9999')
with: (hash2 at: 'foo_1')
- with: (hash2 at: 'foo_9999')) displayNl!
+ with: (hash2 at: 'foo_9999')) displayNl
+]
--- orig/tests/heapsort.ok
+++ mod/tests/heapsort.ok
@@ -3,11 +3,5 @@ Execution begins...
returned value is 42
Execution begins...
-returned value is SmallInteger
-
-Execution begins...
-returned value is Array
-
-Execution begins...
0.9990640718
returned value is '0.9990640718'
--- orig/tests/heapsort.st
+++ mod/tests/heapsort.st
@@ -28,17 +28,18 @@
|
======================================================================"
-Smalltalk at: #Last put: 42!
+Eval [ Smalltalk at: #Last put: 42 ]
-!SmallInteger methodsFor: 'testing'!
-
-nextRandom: max
+SmallInteger extend [
+ nextRandom: max [
Last := self * 3877 + 29573 rem: 139968.
- ^max * Last asFloatD / 139968d! !
+ ^max * Last asFloatD / 139968d
+ ]
+]
-!Array methodsFor: 'testing'!
+Array extend [
-heapSort
+ heapSort [
| j i rra l ir |
ir := self size.
l := self size // 2 + 1.
@@ -64,15 +65,18 @@ heapSort
ifFalse: [ j := ir + 1 ]].
self at: i put: rra
- ] repeat! !
+ ] repeat
+ ]
+]
-| array last n |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-array := Array new: n.
-1 to: n do: [ :i | array at: i put: (Last nextRandom: 1d) ].
+ array := Array new: n.
+ 1 to: n do: [ :i | array at: i put: (Last nextRandom: 1d) ].
-array heapSort.
-((array last + 0.5d-10) printString copyFrom: 1 to: 12) displayNl!
+ array heapSort.
+ ((array last + 0.5d-10) printString copyFrom: 1 to: 12) displayNl
+]
--- orig/tests/intmath.ok
+++ mod/tests/intmath.ok
@@ -177,9 +177,6 @@ Execution begins...
returned value is true
Execution begins...
-returned value is Fraction class
-
-Execution begins...
64212742967590157
1216451004088320000
returned value is Fraction new "<0>"
--- orig/tests/intmath.st
+++ mod/tests/intmath.st
@@ -28,80 +28,80 @@
|
======================================================================"
-^3!
+Eval [ 3 ]
-^-3!
+Eval [ -3 ]
"Base tests"
-^2r1010!
-^8r377!
-^16rFE!
+Eval [ 2r1010 ]
+Eval [ 8r377 ]
+Eval [ 16rFE ]
"Arithmetic operation tests"
-^3 + 4! "should return 7"
+Eval [ 3 + 4 ] "should return 7"
-^3 - 4! "should return -1"
+Eval [ 3 - 4 ] "should return -1"
-^3 < 4! "should return true"
+Eval [ 3 < 4 ] "should return true"
-^17 > 18! "should return false"
-^17 > 17! "should return false"
+Eval [ 17 > 18 ] "should return false"
+Eval [ 17 > 17 ] "should return false"
-^23 <= 23! "true"
-^23 <= -45! "false"
-^18 >= 21! "false"
-^19 >= 18! "true"
+Eval [ 23 <= 23 ] "true"
+Eval [ 23 <= -45 ] "false"
+Eval [ 18 >= 21 ] "false"
+Eval [ 19 >= 18 ] "true"
-^23 = 23! "true"
-^23 = 24! "false"
+Eval [ 23 = 23 ] "true"
+Eval [ 23 = 24 ] "false"
-^45 ~= 89! "true"
-^45 ~= 45! "false"
+Eval [ 45 ~= 89 ] "true"
+Eval [ 45 ~= 45 ] "false"
-^3 * 4! "should return 12"
+Eval [ 3 * 4 ] "should return 12"
-^ 12 // 3! "should return 4"
-^ 12 // 5! "should return 2"
-^-12 // -3! "should return 4"
-^-12 // -5! "should return 2"
-^-12 // 5! "should return -3"
-^ 12 // -5! "should return -3"
+Eval [ 12 // 3 ] "should return 4"
+Eval [ 12 // 5 ] "should return 2"
+Eval [ -12 // -3 ] "should return 4"
+Eval [ -12 // -5 ] "should return 2"
+Eval [ -12 // 5 ] "should return -3"
+Eval [ 12 // -5 ] "should return -3"
-^ 12 \\ 3! "should return 0"
-^ 12 \\ 5! "should return 2"
-^-12 \\ -3! "should return 0"
-^-12 \\ -5! "should return -2"
-^-12 \\ 5! "should return 3"
-^ 12 \\ -5! "should return -3"
+Eval [ 12 \\ 3 ] "should return 0"
+Eval [ 12 \\ 5 ] "should return 2"
+Eval [ -12 \\ -3 ] "should return 0"
+Eval [ -12 \\ -5 ] "should return -2"
+Eval [ -12 \\ 5 ] "should return 3"
+Eval [ 12 \\ -5 ] "should return -3"
"LargeIntegers"
-^(1000000000 raisedToInteger: 4) printString!
+Eval [ (1000000000 raisedToInteger: 4) printString ]
-^100 factorial / 99 factorial! "should return 100 of course"
-^100 factorial printString!
+Eval [ 100 factorial / 99 factorial ] "should return 100 of course"
+Eval [ 100 factorial printString ]
-^(40000 * 40000) = (40000 * 40000)!
-^(40000 * 40000) < (40000 * 40000)!
-^(40000 * 40000) <= (40000 * 40000)!
-^(40000 * 40000) > (40000 * 40000)!
-^(40000 * 40000) >= (40000 * 40000)!
-^(40000 * 40000) = (32000 * 32000)!
-^(40000 * 40000) < (32000 * 32000)!
-^(40000 * 40000) <= (32000 * 32000)!
-^(40000 * 40000) > (32000 * 32000)!
-^(40000 * 40000) >= (32000 * 32000)!
-^(34567 * 34567) = (45678 * 45678)!
-^(34567 * 34567) < (45678 * 45678)!
-^(34567 * 34567) <= (45678 * 45678)!
-^(34567 * 34567) > (45678 * 45678)!
-^(34567 * 34567) >= (45678 * 45678)!
+Eval [ (40000 * 40000) = (40000 * 40000) ]
+Eval [ (40000 * 40000) < (40000 * 40000) ]
+Eval [ (40000 * 40000) <= (40000 * 40000) ]
+Eval [ (40000 * 40000) > (40000 * 40000) ]
+Eval [ (40000 * 40000) >= (40000 * 40000) ]
+Eval [ (40000 * 40000) = (32000 * 32000) ]
+Eval [ (40000 * 40000) < (32000 * 32000) ]
+Eval [ (40000 * 40000) <= (32000 * 32000) ]
+Eval [ (40000 * 40000) > (32000 * 32000) ]
+Eval [ (40000 * 40000) >= (32000 * 32000) ]
+Eval [ (34567 * 34567) = (45678 * 45678) ]
+Eval [ (34567 * 34567) < (45678 * 45678) ]
+Eval [ (34567 * 34567) <= (45678 * 45678) ]
+Eval [ (34567 * 34567) > (45678 * 45678) ]
+Eval [ (34567 * 34567) >= (45678 * 45678) ]
"parsing in bases other than 10"
-16rFFFFFFFF = 4294967295!
+Eval [ 16rFFFFFFFF = 4294967295 ]
-| f n f1 |
+Eval [
n _ 10.
f _ n factorial.
f1 _ f * (n+1).
@@ -110,14 +110,15 @@
n timesRepeat: [f1 _ f1 + f].
((f1 // f) = (n+1)) printNl.
^f1 negated negated = f1
-!
+]
"Check normalization and conversion to/from SmallInts"
- ^(SmallInteger largest + 1 - 1) == SmallInteger largest!
- ^(SmallInteger largest + 3 - 6) == (SmallInteger largest - 3)!
- ^(SmallInteger smallest - 1 + 1) == SmallInteger smallest!
- ^(SmallInteger smallest - 3 + 6) == (SmallInteger smallest + 3)!
+Eval [ ^(SmallInteger largest + 1 - 1) == SmallInteger largest ]
+Eval [ ^(SmallInteger largest + 3 - 6) == (SmallInteger largest - 3) ]
+Eval [ ^(SmallInteger smallest - 1 + 1) == SmallInteger smallest ]
+Eval [ ^(SmallInteger smallest - 3 + 6) == (SmallInteger smallest + 3) ]
+Eval [
| bits |
'Shift -1 left then right and test for -1' printNl.
@@ -142,20 +143,23 @@
'LargeInteger bit logic tests passed' printNl.
^true
-!
+]
-!Fraction class methodsFor: 'instance creation'!
+Fraction class extend [
-test: n
- | sum time |
- sum := 0.
- 1 to: n do: [ :x | sum := sum + 1 / x ].
+ test: n [
+ | sum time |
+ sum := 0.
+ 1 to: n do: [ :x | sum := sum + 1 / x ].
+ ^sum
+ ]
+]
+
+Eval [
+ | sum |
+ sum := Fraction test: 20. "Try 100 or 200..."
+ sum numerator printNl.
+ sum denominator printNl.
^sum
-! !
-
-| sum |
-sum := Fraction test: 20. "Try 100 or 200..."
-sum numerator printNl.
-sum denominator printNl.
-^sum!
+]
--- orig/tests/lists.ok
+++ mod/tests/lists.ok
@@ -1,7 +1,4 @@
Execution begins...
-returned value is SmallInteger
-
-Execution begins...
10000
returned value is 10000
--- orig/tests/lists.st
+++ mod/tests/lists.st
@@ -28,9 +28,9 @@
|
======================================================================"
-!SmallInteger methodsFor: 'testing'!
+SmallInteger extend [
-testLists
+ testLists [
| li1 li2 li3 |
li1 := (1 to: self) asOrderedCollection.
li2 := li1 copy.
@@ -44,12 +44,15 @@ testLists
li1 := li1 reverse.
li1 size = self ifFalse: [ self frob ].
li1 = li2 ifFalse: [ self frob ].
- ^li1 size! !
+ ^li1 size
+ ]
+]
-| n result |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-n timesRepeat: [ result := 10000 testLists ].
-result displayNl!
+ n timesRepeat: [ result := 10000 testLists ].
+ result displayNl
+]
--- orig/tests/lists1.ok
+++ mod/tests/lists1.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is SmallInteger
-
-Execution begins...
100000 99999
false
true
--- orig/tests/lists1.st
+++ mod/tests/lists1.st
@@ -28,40 +28,42 @@
|
======================================================================"
-!SmallInteger methodsFor: 'testing'!
+SmallInteger extend [
+ test [
+ | a b sum |
+ b := OrderedCollection new: self.
+ a := (1 to: self) asOrderedCollection.
+ [ a isEmpty ] whileFalse: [
+ b addLast: a removeLast ].
+
+ ('%1 %2' bindWith: (b at: 1) with: (b at: 2)) displayNl.
+
+ b := b reverse.
+ (b includes: 0) printNl.
+ (b includes: self) printNl.
-test
- | a b sum |
- b := OrderedCollection new: self.
- a := (1 to: self) asOrderedCollection.
- [ a isEmpty ] whileFalse: [
- b addLast: a removeLast ].
-
- ('%1 %2' bindWith: (b at: 1) with: (b at: 2)) displayNl.
-
- b := b reverse.
- (b includes: 0) printNl.
- (b includes: self) printNl.
-
- a := b select: [ :each | each < (self // 2) ].
+ a := b select: [ :each | each < (self // 2) ].
- (a copyFrom: 1 to: (10 min: a size))
- do: [ :each | each print ]
- separatedBy: [ Transcript space ].
+ (a copyFrom: 1 to: (10 min: a size))
+ do: [ :each | each print ]
+ separatedBy: [ Transcript space ].
- Transcript nl.
+ Transcript nl.
- sum := a inject: 0 into: [ :old :each |
- each < 1000 ifTrue: [ old + each ] ifFalse: [ old ] ].
+ sum := a inject: 0 into: [ :old :each |
+ each < 1000 ifTrue: [ old + each ] ifFalse: [ old ] ].
- sum printNl.
- a := a, b.
+ sum printNl.
+ a := a, b.
- ('%1 %2' bindWith: a size with: a last) displayNl! !
+ ('%1 %2' bindWith: a size with: a last) displayNl
+ ]
+]
-| n result |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 100000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-n test!
+ n test
+]
--- orig/tests/lists2.st
+++ mod/tests/lists2.st
@@ -28,24 +28,25 @@
|
======================================================================"
-| i n a b |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 200000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-a := (1 to: n) asOrderedCollection.
-b := OrderedCollection new: n.
+ a := (1 to: n) asOrderedCollection.
+ b := OrderedCollection new: n.
-[a isEmpty] whileFalse: [
+ [a isEmpty] whileFalse: [
b addLast: a removeFirst; addLast: a removeLast ].
-[b isEmpty] whileFalse: [
+ [b isEmpty] whileFalse: [
a addFirst: b removeLast; addFirst: b removeFirst ].
-a size printNl.
+ a size printNl.
-(a copyFrom: 1 to: (10 min: a size))
+ (a copyFrom: 1 to: (10 min: a size))
do: [ :each | each print ]
separatedBy: [ Transcript space ].
-Transcript nl!
+ Transcript nl
+]
--- orig/tests/matrix.ok
+++ mod/tests/matrix.ok
@@ -1,10 +1,4 @@
Execution begins...
-returned value is Array class
-
-Execution begins...
-returned value is Array
-
-Execution begins...
270165 1061760 1453695 1856025
returned value is '270165 1061760 1453695 1856025'
--- orig/tests/matrix.st
+++ mod/tests/matrix.st
@@ -28,53 +28,56 @@
|
======================================================================"
-!Array class methodsFor: 'instance creation'!
-
-newMatrix: rows columns: cols
- | count mx row |
- count := 1.
- mx := self new: rows.
- 1 to: rows do: [ :i |
- row := mx at: i put: (Array new: cols).
- 1 to: cols do: [ :j |
- row at: j put: count.
- count := count + 1
- ].
- ].
- ^mx! !
-
-!Array methodsFor: 'testing'!
-
-atXY: coord
- ^(self at: coord x) at: coord y!
+Array extend [
+ Array class >> newMatrix: rows columns: cols [
+ | count mx row |
+ count := 1.
+ mx := self new: rows.
+ 1 to: rows do: [ :i |
+ row := mx at: i put: (Array new: cols).
+ 1 to: cols do: [ :j |
+ row at: j put: count.
+ count := count + 1
+ ].
+ ].
+ ^mx
+ ]
+
+ atXY: coord [
+ ^(self at: coord x) at: coord y
+ ]
-mmult: m2
- | rows cols terms val mx row myRow |
- rows := self size.
- terms := m2 size.
- cols := m2 first size.
- mx := Array new: rows.
- 1 to: rows do: [ :i |
- row := mx at: i put: (Array new: cols).
- myRow := self at: i.
- 1 to: cols do: [ :j |
- val := 0.
- 1 to: terms do: [ :k |
- val := val + ((myRow at: k) * ((m2 at: k) at: j) bitAnd:
16r3FFF_FFFF) ].
- row at: j put: val.
- ].
- ].
- ^mx! !
-
-| m1 m2 mm size n |
-n := Smalltalk arguments isEmpty
+ mmult: m2 [
+ | rows cols terms val mx row myRow |
+ rows := self size.
+ terms := m2 size.
+ cols := m2 first size.
+ mx := Array new: rows.
+ 1 to: rows do: [ :i |
+ row := mx at: i put: (Array new: cols).
+ myRow := self at: i.
+ 1 to: cols do: [ :j |
+ val := 0.
+ 1 to: terms do: [ :k |
+ val := val + ((myRow at: k) * ((m2 at: k) at: j) bitAnd:
16r3FFF_FFFF) ].
+ row at: j put: val.
+ ].
+ ].
+ ^mx
+ ]
+]
+
+Eval [
+ | m1 m2 mm size n |
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-size := 30.
-m1 := Array newMatrix: size columns: size.
-m2 := Array newMatrix: size columns: size.
-n timesRepeat: [ mm := m1 mmult: m2 ].
-('%1 %2 %3 %4' bindWith: (mm atXY: address@hidden)
- with: (mm atXY: address@hidden) with: (mm atXY: address@hidden)
- with: (mm atXY: address@hidden)) displayNl!
+ size := 30.
+ m1 := Array newMatrix: size columns: size.
+ m2 := Array newMatrix: size columns: size.
+ n timesRepeat: [ mm := m1 mmult: m2 ].
+ ('%1 %2 %3 %4' bindWith: (mm atXY: address@hidden)
+ with: (mm atXY: address@hidden) with: (mm atXY: address@hidden)
+ with: (mm atXY: address@hidden)) displayNl
+]
--- orig/tests/methcall.ok
+++ mod/tests/methcall.ok
@@ -1,14 +1,5 @@
Execution begins...
-returned value is ValueHolder
-
-Execution begins...
-returned value is NthValueHolder
-
-Execution begins...
-returned value is NthValueHolder
-
-Execution begins...
true
false
returned value is false
--- orig/tests/methcall.st
+++ mod/tests/methcall.st
@@ -28,42 +28,41 @@
|
======================================================================"
-!ValueHolder methodsFor: 'testing'!
+ValueHolder extend [
+ activate [ self value: self value not ]
+]
+
+ValueHolder subclass: NthValueHolder [
+ | counter maxCounter |
+
+ maxCounter: anInteger [
+ maxCounter := anInteger
+ ]
-activate
- self value: self value not! !
-
-ValueHolder subclass: #NthValueHolder
- instanceVariableNames: 'counter maxCounter'
- classVariableNames: ''
- poolDictionaries: ''
- category: nil!
-
-!NthValueHolder methodsFor: 'testing'!
-
-maxCounter: anInteger
- maxCounter := anInteger!
-
-value: anObject
+ value: anObject [
super value: anObject.
- counter := 0!
+ counter := 0
+ ]
-activate
+ activate [
(counter := counter + 1) >= maxCounter
- ifTrue: [ super activate ]! !
+ ifTrue: [ super activate ]
+ ]
+]
-| n val toggle ntoggle |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 100000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-val := true.
-toggle := ValueHolder with: val.
-n timesRepeat: [ val := toggle activate value ].
-val displayNl.
-
-val := true.
-ntoggle := NthValueHolder with: val.
-ntoggle maxCounter: 3.
-n timesRepeat: [ val := ntoggle activate value ].
-val displayNl! !
+ val := true.
+ toggle := ValueHolder with: val.
+ n timesRepeat: [ val := toggle activate value ].
+ val displayNl.
+
+ val := true.
+ ntoggle := NthValueHolder with: val.
+ ntoggle maxCounter: 3.
+ n timesRepeat: [ val := ntoggle activate value ].
+ val displayNl
+]
--- orig/tests/mutate.st
+++ mod/tests/mutate.st
@@ -28,112 +28,98 @@
|
======================================================================"
-Object subclass: #A
- instanceVariableNames: 'var1'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
-
-A subclass: #B
- instanceVariableNames: 'var2'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
-
-A class instanceVariableNames: 'instance'!
-
-!A class methodsFor: 'testing'!
-
-instance
- instance isNil ifTrue: [ instance := self new ].
- ^instance! !
-
-!A methodsFor: 'testing'!
-
-printOn: aStream
- aStream
- nextPutAll: self class name;
- nextPut: $(.
-
- self class allInstVarNames keysAndValuesDo: [ :i :each |
- aStream
- nextPutAll: each;
- nextPut: $: ;
- print: (self instVarAt: i);
- space
- ].
-
- aStream nextPut: $)! !
-
-!A methodsFor: 'testing'!
-
-var1
- ^var1!
-
-var1: a
- var1 := a! !
-
-!B methodsFor: 'testing'!
-
-var2
- ^var2!
-
-var2: a
- var2 := a! !
-
-A instance var1: 1.
-A instance printNl.
-
-B instance var1: 0.
-B instance var2: 2.
-B instance printNl.
-
-A addInstVarName: #var2.
-B instance var2 printNl.
-B instance printNl.
-
-A removeInstVarName: #var2.
-B instance var2 printNl.
-B instance printNl.
-
-"Now make B's var2 point to A's"
-A addInstVarName: #var2.
-B removeInstVarName: #var2.
-B instance var2 printNl.
-B instance printNl!
+Object subclass: A [
+ | var1 |
+ var1 [ ^var1 ]
+ var1: a [ var1 := a ]
+
+ printOn: aStream [
+ aStream
+ nextPutAll: self class name;
+ nextPut: $(.
+
+ self class allInstVarNames keysAndValuesDo: [ :i :each |
+ aStream
+ nextPutAll: each;
+ nextPut: $: ;
+ print: (self instVarAt: i);
+ space
+ ].
+
+ aStream nextPut: $)
+ ]
+]
+
+A subclass: B [ |var2|
+ var2 [ ^var2 ]
+ var2: a [ var2 := a ]
+]
+
+A class extend [
+ | instance |
+
+ instance [
+ instance isNil ifTrue: [ instance := self new ].
+ ^instance
+ ]
+]
+
+
+Eval [
+ A instance var1: 1.
+ A instance printNl.
+
+ B instance var1: 0.
+ B instance var2: 2.
+ B instance printNl.
+
+ A addInstVarName: #var2.
+ B instance var2 printNl.
+ B instance printNl.
+
+ A removeInstVarName: #var2.
+ B instance var2 printNl.
+ B instance printNl.
+
+ "Now make B's var2 point to A's"
+ A addInstVarName: #var2.
+ B removeInstVarName: #var2.
+ B instance var2 printNl.
+ B instance printNl
+]
"Now, test using #subclass: to create classes."
-Association subclass: #C!
-C instSize = C allInstVarNames size!
-(C allInstVarNames -> C sharedPools) printNl!
-
-Object subclass: #C instanceVariableNames: 'a' classVariableNames: ''
poolDictionaries: 'SystemExceptions' category: 'foo'!
-C instSize = C allInstVarNames size!
-(C allInstVarNames -> C sharedPools) printNl!
-
-Array subclass: #C!
-C instSize = C allInstVarNames size!
-(C allInstVarNames -> C sharedPools) printNl!
-
-Association subclass: #C!
-C instSize = C allInstVarNames size!
-(C allInstVarNames -> C sharedPools) printNl!
-
-Object subclass: #C instanceVariableNames: '' classVariableNames: 'Foo'
poolDictionaries: 'SystemExceptions' category: 'foo'!
-C instSize = C allInstVarNames size!
-(C classPool keys asArray -> C allInstVarNames -> C sharedPools) printNl!
-
-Association subclass: #C!
-(C classPool keys asArray -> C allInstVarNames -> C sharedPools) printNl!
-
-Object variableSubclass: #C instanceVariableNames: '' classVariableNames:
'Foo' poolDictionaries: 'SystemExceptions' category: 'foo'!
-C instSize = C allInstVarNames size!
-(C shape -> C classPool keys asArray -> C allInstVarNames -> C sharedPools)
printNl!
+Eval [ Association subclass: #C ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C allInstVarNames -> C sharedPools) printNl ]
+
+Eval [ Object subclass: #C instanceVariableNames: 'a' classVariableNames: ''
poolDictionaries: 'SystemExceptions' category: 'foo' ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C allInstVarNames -> C sharedPools) printNl ]
+
+Eval [ Array subclass: #C ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C allInstVarNames -> C sharedPools) printNl ]
+
+Eval [ Association subclass: #C ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C allInstVarNames -> C sharedPools) printNl ]
+
+Eval [ Object subclass: #C instanceVariableNames: '' classVariableNames: 'Foo'
poolDictionaries: 'SystemExceptions' category: 'foo' ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C classPool keys asArray -> C allInstVarNames -> C sharedPools)
printNl ]
+
+Eval [ Association subclass: #C ]
+Eval [ (C classPool keys asArray -> C allInstVarNames -> C sharedPools)
printNl ]
+
+Eval [ Object variableSubclass: #C instanceVariableNames: ''
classVariableNames: 'Foo' poolDictionaries: 'SystemExceptions' category: 'foo' ]
+Eval [ C instSize = C allInstVarNames size ]
+Eval [ (C shape -> C classPool keys asArray -> C allInstVarNames -> C
sharedPools) printNl ]
-Association subclass: #C!
-(C shape -> C classPool keys asArray -> C allInstVarNames -> C sharedPools)
printNl!
+Eval [ Association subclass: #C ]
+Eval [ (C shape -> C classPool keys asArray -> C allInstVarNames -> C
sharedPools) printNl ]
-C class compile: 'foo ^MutationError'!
-^C foo == SystemExceptions.MutationError!
+Eval [ C class compile: 'foo ^MutationError' ]
+Eval [ C foo == SystemExceptions.MutationError ]
--- orig/tests/nestedloop.st
+++ mod/tests/nestedloop.st
@@ -28,23 +28,22 @@
|
======================================================================"
-| n x |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 4 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-x := 0.
-n timesRepeat: [
+ x := 0.
n timesRepeat: [
- n timesRepeat: [
+ n timesRepeat: [
n timesRepeat: [
- n timesRepeat: [
+ n timesRepeat: [
n timesRepeat: [
- x := x + 1
+ n timesRepeat: [ x := x + 1 ]
]
]
]
]
- ]
-].
-x displayNl!
+ ].
+ x displayNl
+]
--- orig/tests/objdump.st
+++ mod/tests/objdump.st
@@ -28,44 +28,50 @@
|
======================================================================"
- | stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
(ObjectDumper on: stream) dump: Array.
stream reset.
- ^(ObjectDumper on: stream) load == Array!
+ ^(ObjectDumper on: stream) load == Array
+]
- | stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
(ObjectDumper on: stream) dump: #('asdf' 1 2 $a).
stream reset.
- ^(ObjectDumper on: stream) load = #('asdf' 1 2 $a)!
+ ^(ObjectDumper on: stream) load = #('asdf' 1 2 $a)
+]
- | method stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
method := Object >> #yourself.
(ObjectDumper on: stream) dump: method.
stream reset.
- ^(ObjectDumper on: stream) load == method!
+ ^(ObjectDumper on: stream) load == method
+]
- | array secondArray stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
array := Array new: 1.
array at: 1 put: array.
(ObjectDumper on: stream) dump: array.
stream reset.
secondArray := (ObjectDumper on: stream) load.
- ^secondArray == (secondArray at: 1)!
+ ^secondArray == (secondArray at: 1)
+]
- | stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
(ObjectDumper on: stream) dump: Processor.
stream reset.
- ^(ObjectDumper on: stream) load == Processor!
+ ^(ObjectDumper on: stream) load == Processor
+]
- | stream |
+Eval [
stream := ByteStream on: (ByteArray new: 1024).
(ObjectDumper on: stream) dump: 'asdf'.
stream reset.
- ^(ObjectDumper on: stream) load = 'asdf'!
+ ^(ObjectDumper on: stream) load = 'asdf'
+]
--- orig/tests/objects.ok
+++ mod/tests/objects.ok
@@ -1,14 +1,5 @@
Execution begins...
-returned value is ObjectsTest
-
-Execution begins...
-returned value is ObjectsTest class
-
-Execution begins...
-returned value is ObjectsTest
-
-Execution begins...
a finalized
b finalized, surviving
c finalized
--- orig/tests/objects.st
+++ mod/tests/objects.st
@@ -28,65 +28,60 @@
|
======================================================================"
-Object subclass: #ObjectsTest
- instanceVariableNames: 'name survive'
- classVariableNames: 'Messages'
- poolDictionaries: ''
- category: nil
-!
+Object subclass: ObjectsTest [
+ | name survive |
-!ObjectsTest class methodsFor: 'test'!
+ Messages := nil.
-testCompaction
- Messages := SortedCollection new.
- ObjectMemory compact.
- Messages do: [ :each | each displayNl ]
-!
+ Class protocol [
+ testCompaction [
+ Messages := SortedCollection new.
+ ObjectMemory compact.
+ Messages do: [ :each | each displayNl ]
+ ]
+
+ testFinalize [
+ | test |
+ self new name: 'a' survive: false.
+ self new name: 'b' survive: true.
+ self new name: 'c' survive: false.
+ self testCompaction.
+ self testCompaction.
+ self testCompaction.
+ ]
+
+ testWeak [
+ | a |
+ a := Array new: 1.
+ a makeWeak.
+ a at: 1 put: Object new.
+ ObjectMemory compact.
+ ^(a at: 1) isNil
+ ]
+ ]
+
+ name: aString survive: aBoolean [
+ name := aString.
+ survive := aBoolean.
+ self addToBeFinalized
+ ]
+
+ finalize [
+ survive ifTrue: [
+ Messages add: name, ' finalized, surviving'.
+ survive := false.
+ self addToBeFinalized.
+ ^self
+ ].
+ Messages add: name, ' finalized'
+ ]
+]
-testFinalize
- | test |
- self new name: 'a' survive: false.
- self new name: 'b' survive: true.
- self new name: 'c' survive: false.
- self testCompaction.
- self testCompaction.
- self testCompaction.
-!
-
-testWeak
- | a |
- a := Array new: 1.
- a makeWeak.
- a at: 1 put: Object new.
- ObjectMemory compact.
- ^(a at: 1) isNil
-! !
+Eval [ ObjectsTest testFinalize ]
+Eval [ ObjectsTest testWeak ]
-!ObjectsTest methodsFor: 'finalization'!
-name: aString survive: aBoolean
- name := aString.
- survive := aBoolean.
- self addToBeFinalized
-!
-
-finalize
- survive ifTrue: [
- Messages add: name, ' finalized, surviving'.
- survive := false.
- self addToBeFinalized.
- ^self
- ].
- Messages add: name, ' finalized'.
-! !
-
-ObjectsTest testFinalize!
-^ObjectsTest testWeak!
-
-
-"TODO: use Eval here, we want 'abc' to survive through the entire
- execution."
-[
+Eval [
| a b |
a := WeakArray new: 5.
@@ -105,12 +100,12 @@ ObjectsTest testFinalize!
((1 to: 5) collect: [ :each | a isAlive: each ]) printNl.
((1 to: 5) collect: [ :each | b isAlive: each ]) printNl
-] value!
+]
"Test lightweight class"
- | Test methodString t |
+Eval [
Test := Behavior new.
Transcript nextPutAll: 'New instance of Behavior created'; nl.
@@ -128,5 +123,5 @@ ObjectsTest testFinalize!
t printTestMessage.
t printNl.
- Transcript nextPutAll: 'Well it seems to work fine'; nl.
-!
+ Transcript nextPutAll: 'Well it seems to work fine'; nl
+]
--- orig/tests/objinst.ok
+++ mod/tests/objinst.ok
@@ -1,14 +1,5 @@
Execution begins...
-returned value is ValueHolder
-
-Execution begins...
-returned value is NthValueHolder
-
-Execution begins...
-returned value is NthValueHolder
-
-Execution begins...
false
true
false
--- orig/tests/objinst.st
+++ mod/tests/objinst.st
@@ -28,44 +28,42 @@
|
======================================================================"
-!ValueHolder methodsFor: 'testing'!
-activate
- self value: self value not! !
-
-ValueHolder subclass: #NthValueHolder
- instanceVariableNames: 'counter maxCounter'
- classVariableNames: ''
- poolDictionaries: ''
- category: nil!
+ValueHolder subclass: NthValueHolder [
+ | counter maxCounter |
-!NthValueHolder methodsFor: 'testing'!
+ ValueHolder >> activate [ self value: self value not ]
-maxCounter: anInteger
- maxCounter := anInteger!
+ maxCounter: anInteger [
+ maxCounter := anInteger
+ ]
-value: anObject
+ value: anObject [
super value: anObject.
- counter := 0!
+ counter := 0
+ ]
-activate
+ activate [
(counter := counter + 1) >= maxCounter
- ifTrue: [ super activate ]! !
+ ifTrue: [ super activate ]
+ ]
+]
-| n val toggle ntoggle |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-val := true.
-toggle := ValueHolder with: val.
-5 timesRepeat: [ toggle activate value printNl ].
-n timesRepeat: [ toggle := ValueHolder with: true ].
-
-Transcript nl.
-
-val := true.
-ntoggle := NthValueHolder with: val.
-ntoggle maxCounter: 3.
-8 timesRepeat: [ ntoggle activate value printNl ].
-n timesRepeat: [ (ntoggle := NthValueHolder with: true) maxCounter: 3 ]! !
+ val := true.
+ toggle := ValueHolder with: val.
+ 5 timesRepeat: [ toggle activate value printNl ].
+ n timesRepeat: [ toggle := ValueHolder with: true ].
+
+ Transcript nl.
+
+ val := true.
+ ntoggle := NthValueHolder with: val.
+ ntoggle maxCounter: 3.
+ 8 timesRepeat: [ ntoggle activate value printNl ].
+ n timesRepeat: [ (ntoggle := NthValueHolder with: true) maxCounter: 3 ]
+]
--- orig/tests/processes.ok
+++ mod/tests/processes.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is Process
-
-Execution begins...
Process('test 1' at userSchedulingPriority, suspended)
'inside p'
Process('test 1' at userSchedulingPriority, terminated)
--- orig/tests/processes.st
+++ mod/tests/processes.st
@@ -28,139 +28,152 @@
|
======================================================================"
-!Process methodsFor: 'testing'!
+Process extend [
-executeUntilTermination
- self isTerminated ifTrue: [ ^self ].
- self isActive ifFalse: [ self resume ].
- [ self isTerminated ] whileFalse: [ Processor yield ]!
-
-ensureTermination
- self terminate; executeUntilTermination
-! !
+ executeUntilTermination [
+ self isTerminated ifTrue: [ ^self ].
+ self isActive ifFalse: [ self resume ].
+ [ self isTerminated ] whileFalse: [ Processor yield ]
+ ]
+
+ ensureTermination [
+ self terminate; executeUntilTermination
+ ]
+]
"Test resuming/terminating a process"
-| p |
-p := [ 'inside p' printNl ] newProcess name: 'test 1'; yourself.
-p printNl.
-p executeUntilTermination.
-p printNl!
+Eval [
+ p := [ 'inside p' printNl ] newProcess name: 'test 1'; yourself.
+ p printNl.
+ p executeUntilTermination.
+ p printNl
+]
"Test Process suspend/resume"
-| p |
-p := [
- 'inside p' printNl.
- p suspend.
- 'suspension finished' printNl ] newProcess name: 'test 2'; yourself.
-p printNl.
-p resume.
-p printNl.
-p executeUntilTermination.
-p printNl!
+Eval [
+ p := [
+ 'inside p' printNl.
+ p suspend.
+ 'suspension finished' printNl ] newProcess name: 'test 2'; yourself.
+ p printNl.
+ p resume.
+ p printNl.
+ p executeUntilTermination.
+ p printNl
+]
"Test processes yielding control to each other without suspending themselves"
-| p testFinished |
-p := [
- 'inside p' printNl.
- Processor yield.
- 'yielded back to p' printNl ] newProcess name: 'test 3'; yourself.
-p printNl.
-p resume.
-p printNl.
-p executeUntilTermination.
-p printNl!
+Eval [
+ p := [
+ 'inside p' printNl.
+ Processor yield.
+ 'yielded back to p' printNl ] newProcess name: 'test 3'; yourself.
+ p printNl.
+ p resume.
+ p printNl.
+ p executeUntilTermination.
+ p printNl
+]
"Test simple wait on a semaphore"
-| p s |
-s := Semaphore new.
-p := [
- 'inside p' printNl.
- s wait.
- 'wait finished' printNl ] newProcess name: 'test 4'; yourself.
-p printNl.
-p resume.
-p printNl.
-s signal.
-p printNl!
+Eval [
+ s := Semaphore new.
+ p := [
+ 'inside p' printNl.
+ s wait.
+ 'wait finished' printNl ] newProcess name: 'test 4'; yourself.
+ p printNl.
+ p resume.
+ p printNl.
+ s signal.
+ p printNl
+]
"Now test process interrupts"
-| s p |
-s := Semaphore new.
-([ [ false ] whileFalse: [ ] ]
- forkAt: Processor userBackgroundPriority)
- name: 'background';
- queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ].
-
-s wait.
-p printNl.
-p ensureTermination.
-p printNl!
+Eval [
+ s := Semaphore new.
+ ([ [ false ] whileFalse: [ ] ]
+ forkAt: Processor userBackgroundPriority)
+ name: 'background';
+ queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ].
+
+ s wait.
+ p printNl.
+ p ensureTermination.
+ p printNl
+]
"Now interrupt a sleeping process"
-| s p |
-s := Semaphore new.
-([ 'should go back to sleep' printNl ] newProcess)
- priority: Processor userInterruptPriority;
- name: 'interrupted';
- queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ].
-
-s wait.
-p printNl.
-p ensureTermination.
-p printNl!
+Eval [
+ s := Semaphore new.
+ ([ 'should go back to sleep' printNl ] newProcess)
+ priority: Processor userInterruptPriority;
+ name: 'interrupted';
+ queueInterrupt: [ (p := Processor activeProcess) printNl. s signal ].
+
+ s wait.
+ p printNl.
+ p ensureTermination.
+ p printNl
+]
"Resume a process and check that it is removed from the semaphore"
-| p1 p2 s p1ok p2ok |
-s := Semaphore new.
-p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
-p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
-p2 resume.
-s signal.
-^p1ok & p2ok & s size = 0!
-
-| p1 p2 s p1ok p2ok |
-s := Semaphore new.
-p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
-p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
-p1 resume.
-s signal.
-^p1ok & p2ok & s size = 0!
+Eval [
+ s := Semaphore new.
+ p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
+ p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
+ p2 resume.
+ s signal.
+ ^p1ok & p2ok & s size = 0
+]
+
+Eval [
+ | p1 p2 s p1ok p2ok |
+ s := Semaphore new.
+ p1 := [ [ s wait ] ensure: [ p1ok := true ] ] fork.
+ p2 := [ [ s wait ] ensure: [ p2ok := true ] ] fork.
+ p1 resume.
+ s signal.
+ ^p1ok & p2ok & s size = 0
+]
"Terminate a process and check that #ensure: blocks are evaluated"
-| p1 p2 s dummy |
-dummy := Semaphore new.
-s := Semaphore new.
-p1 := [ [ dummy wait ] ensure: [ s signal ] ] fork.
-p2 := [ [ dummy wait ] ensure: [ s signal ] ] fork.
-p1 ensureTermination.
-p2 ensureTermination.
-s wait.
-s wait.
-^s size = 0!
-
-| p1 p2 s dummy |
-dummy := Semaphore new.
-s := Semaphore new.
-
-p1 := [
- [
- Processor activeProcess priority: Processor userBackgroundPriority.
- dummy wait
- ] ensure: [ s signal ]
-] fork.
-p2 := [
- [
- Processor activeProcess priority: Processor userBackgroundPriority.
- dummy wait
- ] ensure: [ s signal ]
-] fork.
-
-p1 ensureTermination.
-p2 ensureTermination.
-s wait.
-s wait.
-^s size = 0!
+Eval [
+ dummy := Semaphore new.
+ s := Semaphore new.
+ p1 := [ [ dummy wait ] ensure: [ s signal ] ] fork.
+ p2 := [ [ dummy wait ] ensure: [ s signal ] ] fork.
+ p1 ensureTermination.
+ p2 ensureTermination.
+ s wait.
+ s wait.
+ ^s size = 0
+]
+
+Eval [
+ dummy := Semaphore new.
+ s := Semaphore new.
+
+ p1 := [
+ [
+ Processor activeProcess priority: Processor userBackgroundPriority.
+ dummy wait
+ ] ensure: [ s signal ]
+ ] fork.
+ p2 := [
+ [
+ Processor activeProcess priority: Processor userBackgroundPriority.
+ dummy wait
+ ] ensure: [ s signal ]
+ ] fork.
+
+ p1 ensureTermination.
+ p2 ensureTermination.
+ s wait.
+ s wait.
+ ^s size = 0
+]
--- orig/tests/prodcons.st
+++ mod/tests/prodcons.st
@@ -1,45 +1,45 @@
-| mutex empty full data consumed produced n join |
-
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 10000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-mutex := Semaphore forMutualExclusion.
-empty := Semaphore new.
-full := Semaphore new.
-consumed := produced := 0.
+ mutex := Semaphore forMutualExclusion.
+ empty := Semaphore new.
+ full := Semaphore new.
+ consumed := produced := 0.
-join := Semaphore new.
+ join := Semaphore new.
-empty signal.
+ empty signal.
-[
- | i |
- i := 0.
[
- full wait.
- mutex wait.
- i := data.
- mutex signal.
- empty signal.
- consumed := consumed + 1.
- i = n
- ] whileFalse.
- join signal.
-] fork.
-
-[
- 1 to: n do: [ :i |
- empty wait.
- mutex wait.
- data := i.
- mutex signal.
- full signal.
- produced := produced + 1.
- ].
- join signal.
-] fork.
-
-join wait.
-join wait.
-('%1 %2' bindWith: produced with: consumed) displayNl!
+ | i |
+ i := 0.
+ [
+ full wait.
+ mutex wait.
+ i := data.
+ mutex signal.
+ empty signal.
+ consumed := consumed + 1.
+ i = n
+ ] whileFalse.
+ join signal.
+ ] fork.
+
+ [
+ 1 to: n do: [ :i |
+ empty wait.
+ mutex wait.
+ data := i.
+ mutex signal.
+ full signal.
+ produced := produced + 1.
+ ].
+ join signal.
+ ] fork.
+
+ join wait.
+ join wait.
+ ('%1 %2' bindWith: produced with: consumed) displayNl
+]
--- orig/tests/quit.st
+++ mod/tests/quit.st
@@ -28,4 +28,5 @@
|
======================================================================"
-ObjectMemory quit: 0; quit: 1!
+Eval [ ObjectMemory quit: 0; quit: 1 ]
+Eval [ 'foo' ]
--- orig/tests/random-bench.ok
+++ mod/tests/random-bench.ok
@@ -3,8 +3,5 @@ Execution begins...
returned value is 42
Execution begins...
-returned value is Number
-
-Execution begins...
70.22105052
returned value is '70.22105052'
--- orig/tests/random-bench.st
+++ mod/tests/random-bench.st
@@ -28,18 +28,20 @@
|
======================================================================"
-Smalltalk at: #Last put: 42!
+Eval [ Smalltalk at: #Last put: 42 ]
-!Number methodsFor: 'testing'!
-
-nextRandom
+Number extend [
+ nextRandom [
Last := Last * 3877 + 29573 rem: 139968.
- ^self * Last asFloatD / 139968d! !
+ ^self * Last asFloatD / 139968d
+ ]
+]
-| n |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-n timesRepeat: [ 100d nextRandom ].
-((100d nextRandom + 0.5d-9) printString copyFrom: 1 to: 11) displayNl!
+ n timesRepeat: [ 100d nextRandom ].
+ ((100d nextRandom + 0.5d-9) printString copyFrom: 1 to: 11) displayNl
+]
--- orig/tests/sets.ok
+++ mod/tests/sets.ok
@@ -1,14 +1,5 @@
Execution begins...
-returned value is Object
-
-Execution begins...
-returned value is True
-
-Execution begins...
-returned value is False
-
-Execution begins...
'passed'
'passed'
'passed'
--- orig/tests/sets.st
+++ mod/tests/sets.st
@@ -27,29 +27,17 @@
|
======================================================================"
-!Object methodsFor: 'testing'!
+True extend [
+ Object >> should: aBlock [ aBlock value assert ]
+ assert [ 'passed' printNl ]
+]
+
+False extend [
+ Object >> shouldnt: aBlock [ aBlock value not assert ]
+ assert [ self error: 'failed' ]
+]
-should: aBlock
- aBlock value assert
-!
-
-shouldnt: aBlock
- aBlock value not assert
-! !
-
-!True methodsFor: 'testing'!
-
-assert
- 'passed' printNl.
-! !
-
-!False methodsFor: 'testing'!
-
-assert
- self error: 'failed'
-! !
-
- | set |
+Eval [
set := Set new: 50.
@@ -75,4 +63,4 @@ assert
set remove: 5.
self should: [set includes: #abc].
self shouldnt: [set includes: 5]
-!
+]
--- orig/tests/sieve.st
+++ mod/tests/sieve.st
@@ -28,21 +28,21 @@
|
======================================================================"
-| n count flags0 flags |
-
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 1 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-flags0 := Array new: 8192 withAll: true.
+ flags0 := Array new: 8192 withAll: true.
-n timesRepeat: [
- count := 0.
- flags := flags0 copy.
- 2 to: 8192 do: [ :i |
- (flags at: i) ifTrue: [
- i+i to: 8192 by: i do: [ :j | flags at: j put: false ].
- count := count + 1 ]].
-].
+ n timesRepeat: [
+ count := 0.
+ flags := flags0 copy.
+ 2 to: 8192 do: [ :i |
+ (flags at: i) ifTrue: [
+ i+i to: 8192 by: i do: [ :j | flags at: j put: false ].
+ count := count + 1 ]].
+ ].
-('Count: %1' bindWith: count) displayNl!
+ ('Count: %1' bindWith: count) displayNl
+]
--- orig/tests/strcat.st
+++ mod/tests/strcat.st
@@ -28,12 +28,13 @@
|
======================================================================"
-| n hello |
-n := Smalltalk arguments isEmpty
+Eval [
+ n := Smalltalk arguments isEmpty
ifTrue: [ 10000 ]
ifFalse: [ 1 max: Smalltalk arguments first asInteger ].
-hello := String new writeStream.
-n timesRepeat: [ hello nextPutAll: 'hello
+ hello := String new writeStream.
+ n timesRepeat: [ hello nextPutAll: 'hello
' ].
-hello position displayNl!
+ hello position displayNl
+]
--- orig/tests/strings.ok
+++ mod/tests/strings.ok
@@ -1,8 +1,5 @@
Execution begins...
-returned value is String
-
-Execution begins...
returned value is 'foo'
Execution begins...
--- orig/tests/strings.st
+++ mod/tests/strings.st
@@ -28,32 +28,33 @@
|
======================================================================"
-!String methodsFor: 'testing'!
+String extend [
+ strTest [
+ | str |
+ str := self copy.
+ str at: 1 put: $Q.
+ ^str
+ ]
+]
-strTest
- | str |
- str := self copy.
- str at: 1 put: $Q.
- ^str
+Eval [ 'foo' ]
-! !
+Eval [ 'foo on you' ]
-^'foo'!
-
-^'foo on you'!
-
-^'foo on
+Eval [ 'foo on
multiple line string
-you'!
+you'
+]
-^'test embedded quote marks, can''t I do this?'!
+Eval [ 'test embedded quote marks, can''t I do this?' ]
-^'FUBAR' at: 3!
+Eval [ 'FUBAR' at: 3 ]
-^'quem' copy at: 1 put: $Q!
+Eval [ 'quem' copy at: 1 put: $Q ]
-^'quem' strTest!
+Eval [ 'quem' strTest ]
+Eval [
'should be false ' print. ('###' match: 'quem') printNl.
'should be false ' print. ('###' match: 'bo') printNl.
'should be true ' print. ('* string' match: 'any string') printNl.
@@ -68,4 +69,5 @@ you'!
'should be true ' print. ('*#*' match: '.s') printNl.
'should be true ' print. ('*#*' match: 's') printNl.
'should be false ' print. ('*.st' match: '.s') printNl.
-'should be false ' print. ('*#*' match: '') printNl!
+'should be false ' print. ('*#*' match: '') printNl
+]
--- orig/tests/untrusted.ok
+++ mod/tests/untrusted.ok
@@ -1,20 +1,5 @@
Execution begins...
-returned value is A_Super
-
-Execution begins...
-returned value is A
-
-Execution begins...
-returned value is A
-
-Execution begins...
-returned value is A_Super
-
-Execution begins...
-returned value is A
-
-Execution begins...
returned value is true
Execution begins...
@@ -60,22 +45,13 @@ returned value is nil
Execution begins...
returned value is Set
-untrusted.st:124: invalid assignment to instance variable tally
-untrusted.st:130: invalid assignment to global variable Array
+untrusted.st:104: invalid assignment to instance variable tally
+untrusted.st:110: invalid assignment to global variable Array
Execution begins...
returned value is Set
-
-Execution begins...
-returned value is UntrustedSet
-
-Execution begins...
-returned value is UntrustedSet
-
-Execution begins...
-returned value is UntrustedSet
-untrusted.st:160: invalid assignment to instance variable tally
-untrusted.st:166: invalid assignment to global variable Array
+untrusted.st:131: invalid assignment to instance variable tally
+untrusted.st:133: invalid assignment to global variable Array
Execution begins...
returned value is nil
@@ -93,7 +69,4 @@ Execution begins...
returned value is false
Execution begins...
-returned value is B
-
-Execution begins...
returned value is true
--- orig/tests/untrusted.st
+++ mod/tests/untrusted.st
@@ -28,94 +28,74 @@
|
======================================================================"
-Object subclass: #A_Super
- instanceVariableNames: 'a'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
-
-A_Super subclass: #A
- instanceVariableNames: 'a'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
-
-A makeUntrusted: true!
-
-!A_Super methodsFor: 'checking'!
-
-aSuper
- ^a
-! !
-
-!A methodsFor: 'checking'!
-
-a: value
- a := value
-!
-
-check
- ^thisContext isUntrusted
-!
-
-check: aBlock
- ^aBlock value
-!
-
-dirtyBlock
- ^[ a printString. thisContext isUntrusted ]
-!
-
-cleanBlock
- ^[ thisContext isUntrusted ]
-! !
+Object subclass: A_Super [
+ | a |
+ aSuper [ ^a ]
+]
+
+A_Super subclass: A [
+ | a |
+ <makeUntrusted: true>
+
+ a: value [ a := value ]
+
+ check [ ^thisContext isUntrusted ]
+
+ check: aBlock [ ^aBlock value ]
+
+ dirtyBlock [ ^[ a printString. thisContext isUntrusted ] ]
+
+ cleanBlock [ ^[ thisContext isUntrusted ] ]
+]
"Check that contexts are properly made untrusted -------------------------"
-^A isUntrusted!
-^A new isUntrusted!
-^A new check!
-^A new check: [ thisContext isUntrusted ]!
-^A new check: [ A new check ]!
-^A new check: [ A new check: [ thisContext isUntrusted ] ]!
-^A new check: A new cleanBlock!
-^A new cleanBlock value!
-^A new check: A new dirtyBlock!
-^A new dirtyBlock value!
+Eval [ A isUntrusted ]
+Eval [ A new isUntrusted ]
+Eval [ A new check ]
+Eval [ A new check: [ thisContext isUntrusted ] ]
+Eval [ A new check: [ A new check ] ]
+Eval [ A new check: [ A new check: [ thisContext isUntrusted ] ] ]
+Eval [ A new check: A new cleanBlock ]
+Eval [ A new cleanBlock value ]
+Eval [ A new check: A new dirtyBlock ]
+Eval [ A new dirtyBlock value ]
"Make the current process untrusted... -----------------------------------"
-[
+Eval [
Processor activeProcess makeUntrusted: true.
thisContext isUntrusted
-] value!
+]
"...and check that subsequently created process are trusted."
-^thisContext isUntrusted!
+Eval [ thisContext isUntrusted ]
"Make another process untrusted. -----------------------------------------"
-| s result |
-s := Semaphore new.
-[ result := thisContext isUntrusted. s signal ] newProcess
- makeUntrusted: true;
- resume.
-
-s wait.
-^result!
+Eval [
+ | s result |
+ s := Semaphore new.
+ [ result := thisContext isUntrusted. s signal ] newProcess
+ makeUntrusted: true;
+ resume.
+
+ s wait.
+ ^result
+]
"Check that access restrictions are enforced -----------------------------"
-[
+Eval [
Processor activeProcess makeUntrusted: true.
Set compile: 'lovelyMethod ^tally'.
Set compile: 'dangerousMethod tally := 0'.
Set compile: 'lovelyMethod ^Array'.
Set compile: 'dangerousMethod Array := 0'
-] value!
+]
-![
+Eval [
Processor activeProcess makeUntrusted: true.
Set methodsFor: 'security checking'
-] value!
+]
lovelyMethod
^tally!
@@ -129,7 +109,7 @@ lovelyMethod
dangerousMethod
Array := 0! !
-!Set methodsFor: 'security checking'!
+Eval [ Set methodsFor: 'security checking' ]
lovelyTrustedMethod
^tally!
@@ -143,53 +123,35 @@ lovelyTrustedMethod
dangerousTrustedMethod
Array := 0! !
-Set subclass: #UntrustedSet
- instanceVariableNames: 'a'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
-
-UntrustedSet makeUntrusted: true!
-
-!UntrustedSet methodsFor: 'security checking'!
-
-lovelyMethod
- ^tally!
-
-dangerousMethod
- tally := 0!
-
-lovelyMethod
- ^Array!
-
-dangerousMethod
- Array := 0!
-
-lovelyMethod
- ^a!
-
-lovelyMethod
- a := 1! !
+Set subclass: UntrustedSet [
+ | a |
+ <makeUntrusted: true>
+
+ lovelyMethod [ ^tally ]
+ dangerousMethod [ tally := 0 ]
+ lovelyMethod [ ^Array ]
+ dangerousMethod [ Array := 0 ]
+ lovelyMethod [ ^a ]
+ lovelyMethod [ a := 1 ]
+]
"Check that subclasses are not fragile. This has security implications
as this test shows..."
-^A new a: 5; aSuper!
+Eval [ A new a: 5; aSuper ]
"Check that methods are properly made untrusted. -------------------------"
-^(A >> #check:) isUntrusted!
-^(Set >> #lovelyMethod) isUntrusted!
-^(Set >> #lovelyTrustedMethod) isUntrusted!
-^(Set >> #dangerousTrustedMethod) isUntrusted!
+Eval [ (A >> #check:) isUntrusted ]
+Eval [ (Set >> #lovelyMethod) isUntrusted ]
+Eval [ (Set >> #lovelyTrustedMethod) isUntrusted ]
+Eval [ (Set >> #dangerousTrustedMethod) isUntrusted ]
"Check that subclasses are properly made untrusted. ----------------------"
-A subclass: #B
- instanceVariableNames: 'b'
- classVariableNames: ''
- poolDictionaries: ''
- category: ''!
+A subclass: B [
+ | b |
+]
-^B isUntrusted!
+Eval [ B isUntrusted ]
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] convert regression tests to new syntax,
Paolo Bonzini <=