[strongtalk] r194 committed - Allow instance variable references to be searched for; update test run...

1 view
Skip to first unread message

codesite...@google.com

unread,
Dec 28, 2009, 1:57:40 PM12/28/09
to strongta...@googlegroups.com
Revision: 194
Author: StephenLRees
Date: Mon Dec 28 10:50:00 2009
Log: Allow instance variable references to be searched for; update test
runner interactively during test run
http://code.google.com/p/strongtalk/source/detail?r=194

Modified:
/branches/gcc-linux/StrongtalkSource/AbstractClassMirror.dlt
/branches/gcc-linux/StrongtalkSource/ClassTest.dlt
/branches/gcc-linux/StrongtalkSource/ClassVMMirror.dlt
/branches/gcc-linux/StrongtalkSource/InstanceVariableOutliner.dlt
/branches/gcc-linux/StrongtalkSource/Mirror.dlt
/branches/gcc-linux/StrongtalkSource/MixinDeclMirror.dlt
/branches/gcc-linux/StrongtalkSource/MixinMirror.dlt
/branches/gcc-linux/StrongtalkSource/ReadString.dlt
/branches/gcc-linux/StrongtalkSource/Smalltalk.dlt
/branches/gcc-linux/StrongtalkSource/TestRunner.dlt
/branches/gcc-linux/StrongtalkSource/TextModel.dlt
/branches/gcc-linux/build.win32/strongtalk.ncb
/branches/gcc-linux/build.win32/strongtalk.suo

=======================================
--- /branches/gcc-linux/StrongtalkSource/AbstractClassMirror.dlt Sat Nov 1
12:10:49 2008
+++ /branches/gcc-linux/StrongtalkSource/AbstractClassMirror.dlt Mon Dec 28
10:50:00 2009
@@ -96,6 +96,12 @@
self deltaHack.
^self subclasses!

+inheritsFrom: aMixin <Mixin> ^ <Boolean>
+
+ self mixin reflectee == aMixin ifTrue: [^true].
+ ^(ClassVMMirror on: self reflectee)
+ inheritsFrom: aMixin!
+
instanceSide ^ <ClassMirror>

^self actualClass on: self reflectee instanceClass!
=======================================
--- /branches/gcc-linux/StrongtalkSource/ClassTest.dlt Sat Oct 10 17:23:44
2009
+++ /branches/gcc-linux/StrongtalkSource/ClassTest.dlt Mon Dec 28 10:50:00
2009
@@ -15,7 +15,8 @@
tearDown

self classFixture isNil
- ifFalse: [(Mirror on: self classFixture) removeDefinitionIfFail: [:err|
self signalFailure: err]]! !
+ ifFalse: [(Mirror on: self classFixture) removeDefinitionIfFail: [:err|
self signalFailure: err]].
+ Processor yield! !

! (Delta mirrorFor: #ClassTest) methodsFor: 'testing' !

=======================================
--- /branches/gcc-linux/StrongtalkSource/ClassVMMirror.dlt Sat Dec 19
12:39:38 2009
+++ /branches/gcc-linux/StrongtalkSource/ClassVMMirror.dlt Mon Dec 28
10:50:00 2009
@@ -291,6 +291,16 @@
^ClassMirror subclassHierarchy at: c
ifAbsent:[OrderedCollection[Class] new]!

+inheritsFrom: aMixin <Mixin>
+
+ self mixin reflectee == aMixin
+ ifTrue: [^true].
+ self superclasses do: [:sc|
+ (ClassVMMirror on: sc) mixin reflectee == aMixin
+ ifTrue: [^true]].
+ ^false
+!
+
instanceSide ^<ClassVMMirror>

^self class on: self reflectee instanceClass.
@@ -421,6 +431,21 @@
ifFalse:[self superclass depth]


+!
+
+superclasses ^ <Cltn[Class]>
+
+"Return the class' superclasses"
+
+ |superclasses sc|
+ superclasses := OrderedCollection new.
+ sc := self superclass.
+ [sc notNil]
+ whileTrue: [superclasses add: sc reflectee.
+ sc := sc superclass].
+ ^superclasses
+
+
! !

! (Delta mirrorFor: #ClassVMMirror) methodsFor: 'iteration' !
=======================================
--- /branches/gcc-linux/StrongtalkSource/InstanceVariableOutliner.dlt Sat
Nov 1 12:10:49 2008
+++ /branches/gcc-linux/StrongtalkSource/InstanceVariableOutliner.dlt Mon
Dec 28 10:50:00 2009
@@ -21,7 +21,26 @@


referencesToInstVar
-! !
+
+ self instVarNames size = 1
+ ifTrue: [^self referencesToInstVar: (self instVarNames anElement)].
+ self launchListDialogWithPainter: Painter default
+ title: 'Select instance variable'
+ contents: self instVarNames
+ multi: false
+ action: [:items|
+ self referencesToInstVar: (self instVarNames at: items anElement)]!
+
+referencesToInstVar: instVar <Symbol>
+
+ | references |
+ references := Smalltalk
+ referencesToInstVarName: instVar
+ for: self mixin reflectee.
+ self
+ launchSelectorListWithPainter: Painter default
+ title: 'References to instance variable "', instVar, '"'
+ contents: references! !

! (Delta mirrorFor: #InstanceVariableOutliner) methodsFor: 'menus' !

@@ -50,6 +69,21 @@

^'Instance variables'!

+instVarNames
+
+ | names |
+ names := OrderedCollection new.
+ self mirror instanceVariablesDo: [:var|
+ names add: var name].
+ ^names
+ !
+
+mixin
+
+ ^self mirror isMixin
+ ifTrue: [self mirror]
+ ifFalse: [self mirror mixin]!
+
modelAsCharGlyphs ^ <CharGlyphs>

| tool <ASTtoRichTextTool[CharGlyph]> pts <Cltn[ParseTree]> |
=======================================
--- /branches/gcc-linux/StrongtalkSource/Mirror.dlt Sun Sep 13 14:52:44 2009
+++ /branches/gcc-linux/StrongtalkSource/Mirror.dlt Mon Dec 28 10:50:00 2009
@@ -190,6 +190,10 @@

self subclassResponsibility!

+isMixin ^ <Boolean>
+
+ ^false!
+
mayNeedToUnwind

"Used to mark where we may have to use unwind:protect:
=======================================
--- /branches/gcc-linux/StrongtalkSource/MixinDeclMirror.dlt Sat Oct 10
17:23:44 2009
+++ /branches/gcc-linux/StrongtalkSource/MixinDeclMirror.dlt Mon Dec 28
10:50:00 2009
@@ -749,6 +749,10 @@
self invocations do: [ :inv <AbstractClassMirror> | heirs addAll: inv
immediateHeirs ].
^heirs!

+inheritsFrom: aMixin <Mixin> ^ <Boolean>
+
+ ^self reflectee == aMixin!
+
initializeSuperclassType: s body: b

"self reflect: MixinVMMirror createNewMixin."
@@ -958,6 +962,10 @@
^DefinitionReader for: self category: category
!

+mixin ^ <MixinMirror>
+
+ ^self!
+
mixinDecl ^ <MixinVMMirror>

^mixinDecl!
=======================================
--- /branches/gcc-linux/StrongtalkSource/MixinMirror.dlt Mon Sep 25
12:14:30 2006
+++ /branches/gcc-linux/StrongtalkSource/MixinMirror.dlt Mon Dec 28
10:50:00 2009
@@ -64,6 +64,10 @@

^self class new reflect: self mixinDecl instanceSide!

+isMixin
+
+ ^true!
+
komment

"This is an abstract superclass for the mixin mirror hierarchy"!
=======================================
--- /branches/gcc-linux/StrongtalkSource/ReadString.dlt Sun Sep 13 14:52:44
2009
+++ /branches/gcc-linux/StrongtalkSource/ReadString.dlt Mon Dec 28 10:50:00
2009
@@ -221,6 +221,14 @@
a return type of String, use #stringCopyWithout:"
^guaranteed <VarSeqCltn[EX]> (self copyReplaceAll: (Array[Object] with:
el) with: '')!

+lastNonBlank
+
+ self size to: 1 by: -1 do: [:i|
+ (self at: i) isSeparator
+ ifFalse: [^i]].
+ ^0
+ !
+
stringCopyFrom: start <Int> to: stop <Int> ^<String>
"Like #copyFrom:to:, but has a stronger return type for strings"

@@ -249,7 +257,12 @@
| a <String> |
a := String new: s.
a replaceFrom: 1 to: (self size min: s) with: self.
- ^a! !
+ ^a!
+
+trimBlanks
+
+ ^self stringCopyFrom: 1 to: self lastNonBlank
+ ! !

! (Delta mirrorFor: #ReadString) methodsFor: 'fake brands' !

=======================================
--- /branches/gcc-linux/StrongtalkSource/Smalltalk.dlt Mon Dec 28 10:40:02
2009
+++ /branches/gcc-linux/StrongtalkSource/Smalltalk.dlt Mon Dec 28 10:50:00
2009
@@ -1023,6 +1023,19 @@
ifTrue: [ result add: m,,method selector ] ] ].
^result asSortedCollection: [ :t1 <Tuple[Mirror, Symbol]> :t2
<Tuple[Mirror, Symbol]> | t1 at1 name < t2 at1 name or: [ t1 at1 name = t2
at1 name and: [ t1 at2 <= t2 at2 ] ] ].!

+referencesToInstVarName: name <Symbol> for: holder <Mixin> ^
<SeqCltn[Tuple[Mirror, Symbol]]>
+
+ | result <OrderedCollection[Tuple[Mirror, Symbol]]> |
+ result := OrderedCollection[Tuple[Mirror, Symbol]] new.
+ self classesAndMixinsReflectiveDo: [ :m <ClassMirror|MixinMirror> |
+ (m inheritsFrom: holder)
+ ifTrue: [m compiledMethodsDo: [ :method <Method> | "We use compiled
methods here since otherwise type info will have to be loaded"
+ (method referencesInstVarName: name for: m mixin reflectee)
+ ifTrue: [ result add: m,,method selector ]]]].
+ ^result asSortedCollection: [ :t1 <Tuple[Mirror, Symbol]> :t2
<Tuple[Mirror, Symbol]> |
+ t1 at1 name < t2 at1 name
+ or: [ t1 at1 name = t2 at1 name and: [ t1 at2 <= t2 at2 ] ]
].!
+
renameGroup: grp <Dict[Symbol, Symbol]>

self definitionsReflectiveDo:[: dm <Mirror> |
=======================================
--- /branches/gcc-linux/StrongtalkSource/TestRunner.dlt Mon Dec 28 10:40:02
2009
+++ /branches/gcc-linux/StrongtalkSource/TestRunner.dlt Mon Dec 28 10:50:00
2009
@@ -160,7 +160,9 @@
testsColumn := Column holding: (OrderedCollection
with: (listEqualizer for: testsList with3DBorder)
with: (buttonEqualizer for: (Button labeled: self
refreshButtonLabel
- action: [:b| self refreshTests]))).
+ action: [:b| self
+ refreshTests;
+ refreshWindow]))).
failureColumn := Column holding: (OrderedCollection
with: (listEqualizer for: failuresList with3DBorder)
with: (buttonEqualizer for: (Button labeled: self
runButtonLabel
@@ -216,7 +218,7 @@

visualAllocated

-" self refreshWindow"! !
+ self refreshWindow! !

! (Delta mirrorFor: #TestRunner) methodsFor: 'private-control' !

@@ -386,7 +388,7 @@
self changed: #selectedFailureTest. "added rew"
self changed: #selectedErrorTest. "added rew"
self changed: #selectedSuite.
- self refreshWindow!
+ "self refreshWindow"!

refreshWindow

@@ -405,8 +407,8 @@
self refreshWindow: 'Running...'!

update: aspect with: value
-
- self inSessionProcessDo: [self refreshTests]!
+"notification from Delta of update to classes in system"
+ self refreshTests!

updateAll

@@ -414,7 +416,7 @@
self changed: #selectedSuite.
self changed: #details.
self changed: #passFail.
- self refreshWindow!
+ "self refreshWindow"!

updateDetails: aTestResult

=======================================
--- /branches/gcc-linux/StrongtalkSource/TextModel.dlt Sat Nov 1 12:10:49
2008
+++ /branches/gcc-linux/StrongtalkSource/TextModel.dlt Mon Dec 28 10:50:00
2009
@@ -41,5 +41,10 @@
update: anAspect

anAspect == aspect
- ifTrue: [view model: (model perform: aspect)]! !
-
+ ifTrue: [
+ | newText |
+ newText := (model perform: aspect).
+ view model: newText.
+ view visual hasMedium
+ ifTrue:[view displayNowIfInvalid]]! !
+
=======================================
--- /branches/gcc-linux/build.win32/strongtalk.ncb Mon Dec 28 10:47:15 2009
+++ /branches/gcc-linux/build.win32/strongtalk.ncb Mon Dec 28 10:50:00 2009
File is too large to display a diff.
=======================================
--- /branches/gcc-linux/build.win32/strongtalk.suo Mon Dec 28 10:47:15 2009
+++ /branches/gcc-linux/build.win32/strongtalk.suo Mon Dec 28 10:50:00 2009
Binary file, no diff available.

Reply all
Reply to author
Forward
0 new messages