--- a/MethodFinder.st Wed Sep 05 10:11:26 2012 +0100
+++ b/MethodFinder.st Wed Sep 05 12:45:38 2012 +0100
@@ -224,7 +224,7 @@
"replace data2 with const in expressions"
subTest expressions do: [:exp |
- expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
+ expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].
selector addAll: subTest selectors.
^ true
!
@@ -253,7 +253,7 @@
"replace data2 with const in expressions"
subTest expressions do: [:exp |
- expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
+ expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].
selector addAll: subTest selectors.
^ true
!
@@ -276,7 +276,7 @@
"replace data2 with const in expressions"
subTest expressions do: [:exp |
- expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
+ expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].
selector addAll: subTest selectors.
^ true
!
@@ -307,7 +307,7 @@
"replace data2 with const in expressions"
subTest expressions do: [:exp |
- expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
+ expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].
selector addAll: subTest selectors.
^ true
!
@@ -323,7 +323,7 @@
"replace data2 with const in expressions"
subTest expressions do: [:exp |
- expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
+ expressions add: (exp copyReplaceString: "copyReplaceAll:" 'data2' withString: "with:" const printString)].
selector addAll: subTest selectors.
^ true
! !
@@ -1189,28 +1189,40 @@
"Modified: / 13.11.2001 / 19:28:41 / cg"
!
-load: dataWithAnswers
- "Find a function that takes the data and gives the answers. Odd list entries are data for it, even ones are the answers. nil input means data and answers were supplied already."
-" (MethodFinder new) load: #( (4 3) 7 (-10 5) -5 (-3 11) 8);
- findMessage "
-
-dataWithAnswers ifNotNil: [
- data _ Array new: dataWithAnswers size // 2.
- 1 to: data size do: [:ii | data at: ii put: (dataWithAnswers at: ii*2-1)].
- answers _ Array new: data size.
- 1 to: answers size do: [:ii | answers at: ii put: (dataWithAnswers at: ii*2)]].
-data do: [:list |
- (list isKindOf: SequenceableCollection) ifFalse: [
- ^ self warn: 'first and third items are not Arrays'].
+load:dataWithAnswers
+ "Find a function that takes the data and gives the answers. Odd list entries are data for it, even ones are the answers. nil input means data and answers were supplied already."
+ " (MethodFinder new) load: #( (4 3) 7 (-10 5) -5 (-3 11) 8);
+ findMessage"
+
+ dataWithAnswers
+ ifNotNil:[
+ data := Array new:dataWithAnswers size // 2.
+ 1 to:data size do:[:ii |
+ data at:ii put:(dataWithAnswers at:ii * 2 - 1)
+ ].
+ answers := Array new:data size.
+ 1 to:answers size do:[:ii |
+ answers at:ii put:(dataWithAnswers at:ii * 2)
+ ]
].
-argMap _ (1 to: data first size) asArray.
-data do: [:list | list size = argMap size ifFalse: [
- self warn: 'data arrays must all be the same size']].
-argMap size > 4 ifTrue: [self warn: 'No more than a receiver and
-three arguments allowed'].
- "Really only test receiver and three args."
-thisData _ data copy.
-mapStage _ mapList _ nil.
+ data do:[:list |
+ (list isSequenceable) ifFalse:[
+ ^ self warn:'first and third items are not Arrays'
+ ].
+ ].
+ argMap := (1 to:data first size) asArray.
+ data do:[:list |
+ list size = argMap size ifFalse:[
+ self warn:'data arrays must all be the same size'
+ ]
+ ].
+ argMap size > 4 ifTrue:[
+ self warn:'No more than a receiver and
+three arguments allowed'
+ ].
+ "Really only test receiver and three args."
+ thisData := data copy.
+ mapStage := mapList := nil.
!
noteDangerous
@@ -1355,14 +1367,14 @@
"Control the search."
data do: [:alist |
- (alist isKindOf: SequenceableCollection) ifFalse: [
+ (alist isSequenceable) ifFalse: [
^ OrderedCollection with: 'first and third items are not Arrays']].
true "Approved isNil" ifTrue: [self initialize]. "Sets of allowed selectors"
- expressions _ OrderedCollection new.
+ expressions := OrderedCollection new.
self search: true. "multi"
expressions isEmpty ifTrue: [^ OrderedCollection with: 'no single method does that function'].
- expressions class = String ifTrue: [^ OrderedCollection with: expressions].
+ expressions isString ifTrue: [^ OrderedCollection with: expressions].
^ expressions
!
@@ -1455,77 +1467,102 @@
]]]]].
!
-testPerfect: aSelector
- "Try this selector!! Return true if it answers every example perfectly.
- Take the args in the order they are. Do not permute them.
- Survive errors. later cache arg lists."
-
-| sz argList val rec activeSel perform argIsBlock expectedAnswer|
- "Transcript cr; show: aSelector. debug"
-perform:=aSelector beginsWith: 'perform:'.
-sz:=argMap size.
-1 to: thisData size do: [:ii | "each example set of args"
- argList:=(thisData at: ii) copyFrom: 2 to: sz.
- perform
- ifFalse: [activeSel:=aSelector]
- ifTrue: [activeSel:=argList first. "what will be performed"
- ((Approved includes: activeSel) or: [AddAndRemove includes: activeSel])
- ifFalse: [^ false]. "not approved"
- aSelector == #perform:withArguments:
- ifTrue: [activeSel numArgs = (argList at: 2) basicSize "avoid error"
- ifFalse: [^ false]]
- ifFalse: [activeSel numArgs = (aSelector numArgs - 1)
- ifFalse: [^ false]]].
-
+testPerfect:aSelector
+ "Try this selector!! Return true if it answers every example perfectly.
+ Take the args in the order they are. Do not permute them.
+ Survive errors. later cache arg lists."
+
+ |sz argList val rec activeSel perform argIsBlock expectedAnswer|
- 1 to: sz do: [:num |
- (Blocks includes: (Array with: activeSel with: num)) ifTrue: [
- Smalltalk isSmalltalkX ifTrue:[
- argIsBlock := (argList at: num) isBlock
- ] ifFalse:[
- argIsBlock := (argList at: num) class == BlockContext
- ].
- argIsBlock ifFalse: [
- (BlocksOptional includes: (Array with: activeSel with: num)) ifFalse: [
- ^ false
- ]
- ]]].
- " (activeSel = #capitalized) ifTrue:[self halt.]. " " used to test "
-
- rec:=(AddAndRemove includes: activeSel)
- ifTrue: [(thisData at: ii) first class == Symbol ifTrue: [^ false].
- "vulnerable to modification"
- (thisData at: ii) first copyTwoLevel] "protect from damage"
- ifFalse: [[(thisData at: ii) first]ifError:[self halt.]] .
-
- expectedAnswer := (answers at: ii).
- val:= [ rec copy perform: aSelector withArguments: argList]
- ifError: [:aSignal|
-"/ Transcript showCR:aSignal description.
- "self test3."
- "self test2: (thisData at: ii)."
- ^ false].
- "self test3."
- "self test2: (thisData at: ii)."
- (expectedAnswer isKindOf: Number)
- ifFalse:[
+ "Transcript cr; show: aSelector. debug"
+ perform := aSelector beginsWith:'perform:'.
+ sz := argMap size.
+ 1 to:thisData size do:[:ii |
+ "each example set of args"
+ argList := (thisData at:ii) copyFrom:2 to:sz.
+ perform ifFalse:[
+ activeSel := aSelector
+ ] ifTrue:[
+ activeSel := argList first.
+ ((Approved includes:activeSel) or:[ AddAndRemove includes:activeSel ]) ifFalse:[
+ ^ false
+ ].
+ aSelector == #perform:withArguments: ifTrue:[
+ activeSel numArgs = (argList at:2) basicSize "avoid error" ifFalse:[
+ ^ false
+ ]
+ ] ifFalse:[
+ activeSel numArgs = (aSelector numArgs - 1) ifFalse:[
+ ^ false
+ ]
+ ]
+ ].
+ 1 to:sz do:[:num |
+ (Blocks includes:(Array with:activeSel with:num)) ifTrue:[
+ Smalltalk isSmalltalkX ifTrue:[
+ argIsBlock := (argList at:num) isBlock
+ ] ifFalse:[
+ argIsBlock := (argList at:num) class == BlockContext
+ ].
+ argIsBlock ifFalse:[
+ (BlocksOptional includes:(Array with:activeSel with:num)) ifFalse:[
+ ^ false
+ ]
+ ]
+ ]
+ ].
+ " (activeSel = #capitalized) ifTrue:[self halt.]. " " used to test "
+ rec := (AddAndRemove includes:activeSel) ifTrue:[
+ (thisData at:ii) first class == Symbol ifTrue:[
+ ^ false
+ ].
+ "vulnerable to modification"
+ (thisData at:ii) first copyTwoLevel "protect from damage"
+ ] ifFalse:[
+ [
+ (thisData at:ii) first
+ ] ifError:[ self halt. ]
+ ].
+ expectedAnswer := (answers at:ii).
+ val := [
+ rec copy perform:aSelector withArguments:argList
+ ] ifError:[:aSignal |
+ "/ Transcript showCR:aSignal description.
+ "self test3."
+ "self test2: (thisData at: ii)."
+ ^ false
+ ].
+ "self test3." "self test2: (thisData at: ii)."
+ (expectedAnswer isNumber) ifFalse:[
expectedAnswer isArray ifTrue:[
- (val isCollection and:[val isString not]) ifTrue:[
- ([val asArray = expectedAnswer] ifError:[false]) ifTrue:[^ true].
+ (val isCollection and:[ val isString not ]) ifTrue:[
+ ([
+ val asArray = expectedAnswer
+ ] ifError:[ false ]) ifTrue:[
+ ^ true
+ ].
].
].
+
"/ would like to remember 'almost' same, and present in separate list.
"/ expectedAnswer isString ifTrue:[
"/ (val isString) ifTrue:[
"/ ([val sameAs: expectedAnswer] ifError:[false]) ifTrue:[self halt. ^ true].
"/ ].
"/ ].
- ([ (expectedAnswer = val) ] ifError:[ false]) ifFalse: [^ false]
- ]
- ifTrue:[
- (expectedAnswer closeTo: val) ifFalse: [^ false]].
+
+ ([
+ (expectedAnswer = val)
+ ] ifError:[ false ]) ifFalse:[
+ ^ false
+ ]
+ ] ifTrue:[
+ (expectedAnswer closeTo:val) ifFalse:[
+ ^ false
+ ]
].
- ^ true
+ ].
+ ^ true
"Modified: / 13.11.2001 / 19:08:39 / cg"
! !
@@ -1593,15 +1630,13 @@
!MethodFinder class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/MethodFinder.st,v 1.28 2012/01/31 09:47:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/MethodFinder.st,v 1.30 2012/08/23 21:07:40 cg Exp $'
!
version_CVS
- ^ 'Header: /cvs/stx/stx/libbasic3/MethodFinder.st,v 1.28 2012/01/31 09:47:40 cg Exp '
+ ^ '§Header: /cvs/stx/stx/libbasic3/MethodFinder.st,v 1.30 2012/08/23 21:07:40 cg Exp §'
!
version_SVN
- ^ '$Id: MethodFinder.st 1909 2012-03-31 00:14:49Z vranyj1 $'
+ ^ '$Id: MethodFinder.st 1957 2012-09-05 11:45:38Z vranyj1 $'
! !
-
-