[squeak-dev] Squeak 4.6: ST80Tests-nice.2.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 5 20:15:34 UTC 2015


Chris Muller uploaded a new version of ST80Tests to project Squeak 4.6:
http://source.squeak.org/squeak46/ST80Tests-nice.2.mcz

==================== Summary ====================

Name: ST80Tests-nice.2
Author: nice
Time: 16 December 2013, 5:30:14.254 pm
UUID: 7ee5426b-73f1-48ac-8ec4-3943dc452cb6
Ancestors: ST80Tests-fbs.1

MVCToolBuilderTests are kind of TestCase and belong to ST80Tests

==================== Snapshot ====================

SystemOrganization addCategory: #ST80Tests!

ToolBuilderTests subclass: #MVCToolBuilderTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ST80Tests'!

!MVCToolBuilderTests commentStamp: 'ar 2/11/2005 15:02' prior: 0!
Tests for the MVC tool builder.!

----- Method: MVCToolBuilderTests>>acceptWidgetText (in category 'support') -----
acceptWidgetText
	widget hasUnacceptedEdits: true.
	widget controller accept.!

----- Method: MVCToolBuilderTests>>changeListWidget (in category 'support') -----
changeListWidget
	widget changeModelSelection: widget getCurrentSelectionIndex + 1.!

----- Method: MVCToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
expectedButtonSideEffects
	^#(getState)!

----- Method: MVCToolBuilderTests>>fireButtonWidget (in category 'support') -----
fireButtonWidget
	widget performAction.!

----- Method: MVCToolBuilderTests>>setUp (in category 'support') -----
setUp
	super setUp.
	builder := MVCToolBuilder new.!

----- Method: MVCToolBuilderTests>>tearDown (in category 'support') -----
tearDown
	ScreenController new restoreDisplay.
	super tearDown!

----- Method: MVCToolBuilderTests>>testAddAction (in category 'tests-not applicable') -----
testAddAction
	"MVCToolBuilder does not implement #buildPluggableMenu:"!

----- Method: MVCToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-not applicable') -----
testAddTargetSelectorArgumentList
	"MVCToolBuilder does not implement #buildPluggableMenu:"!

----- Method: MVCToolBuilderTests>>testButtonFiresBlock (in category 'tests-not applicable') -----
testButtonFiresBlock
	"MVC buttons only support action Symbols"!

----- Method: MVCToolBuilderTests>>testButtonFiresMessage (in category 'tests-not applicable') -----
testButtonFiresMessage
	"MVC buttons only support action Symbols, not MessageSends"!

----- Method: MVCToolBuilderTests>>testButtonInitiallyDisabled (in category 'tests-not applicable') -----
testButtonInitiallyDisabled
	"MVC does not have button enablement"!

----- Method: MVCToolBuilderTests>>testButtonInitiallyDisabledSelector (in category 'tests-not applicable') -----
testButtonInitiallyDisabledSelector
	"MVC does not have button enablement"!

----- Method: MVCToolBuilderTests>>testGetButtonColor (in category 'tests-not applicable') -----
testGetButtonColor
	"MVC buttons do not have color"!

----- Method: MVCToolBuilderTests>>testGetButtonEnabled (in category 'tests-not applicable') -----
testGetButtonEnabled
	"MVC does not have button enablement"!

----- Method: MVCToolBuilderTests>>testGetInputFieldColor (in category 'tests-not applicable') -----
testGetInputFieldColor
	"MVC input fields do not have color"!

----- Method: MVCToolBuilderTests>>testGetPanelChildren (in category 'tests-not applicable') -----
testGetPanelChildren
	"MVC panels do not allow changing children"!

----- Method: MVCToolBuilderTests>>testGetTextColor (in category 'tests-not applicable') -----
testGetTextColor
	"not supported in MVC"!

----- Method: MVCToolBuilderTests>>testGetWindowChildren (in category 'tests-not applicable') -----
testGetWindowChildren
	"not supported in MVC"!

----- Method: MVCToolBuilderTests>>testGetWindowLabel (in category 'tests-not applicable') -----
testGetWindowLabel
	"not supported in MVC"!

----- Method: MVCToolBuilderTests>>testTreeExpandPath (in category 'tests-not applicable') -----
testTreeExpandPath
	"MVCToollBuilder does not implement trees"!

----- Method: MVCToolBuilderTests>>testTreeExpandPathFirst (in category 'tests-not applicable') -----
testTreeExpandPathFirst
	"MVCToollBuilder does not implement trees"!

----- Method: MVCToolBuilderTests>>testTreeGetSelectionPath (in category 'tests-not applicable') -----
testTreeGetSelectionPath
	"MVCToollBuilder does not implement trees"!

----- Method: MVCToolBuilderTests>>testTreeRoots (in category 'tests-not applicable') -----
testTreeRoots
	"MVCToollBuilder does not implement trees"!

----- Method: MVCToolBuilderTests>>testTreeWidgetID (in category 'tests-not applicable') -----
testTreeWidgetID
	"MVCToollBuilder does not implement trees"!

----- Method: MVCToolBuilderTests>>testWindowCloseAction (in category 'tests-not applicable') -----
testWindowCloseAction
	"This can only work if we're actually run in MVC"
	World isNil ifTrue: [super testWindowCloseAction]!

TestCase subclass: #ST80PackageDependencyTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ST80Tests'!

----- Method: ST80PackageDependencyTest>>testPackage:dependsExactlyOn: (in category 'as yet unclassified') -----
testPackage: pkgName dependsExactlyOn: pkgList
	"Ensure that the package with the given name depends only on the packages in pkgList.
	NOTE: If you use this for fixing dependencies, classDeps includes the classes
	and users from the package(s) not declared as dependents. Basically, you need
	to fix all the references in classDeps to make the test pass."
	| classDeps pi pkgDeps |
	classDeps := IdentityDictionary new.
	pi := PackageOrganizer default packageNamed: pkgName ifAbsent:[^self]. "unloaded"
	pi classes do:[:pkgClass| 
		(classDeps at: (pkgClass superclass ifNil:[ProtoObject]) 
			ifAbsentPut:[OrderedCollection new]) add: pkgClass name, ' superclass'.
	].
	pi methods do:[:mref| | cm |
		cm := mref compiledMethod.
		1 to: cm numLiterals do:[:i| | lit |
			((lit := cm literalAt: i) isVariableBinding 
				and:[lit value isBehavior]) ifTrue:[(classDeps at: lit value ifAbsentPut:[OrderedCollection new]) add: cm methodClass asString, '>>', cm selector]]].
	pkgDeps := Dictionary new.
	classDeps keys do:[:aClass| | pkg |
		pkg := PackageOrganizer default packageOfClass: aClass ifNone:[nil].
		pkg ifNil:[
			Transcript cr; show: 'WARNING: No package for ', aClass.
			(classDeps removeKey: aClass) do:[:each| Transcript crtab; show: each].
		] ifNotNil:[
			(pkgDeps at: pkg name ifAbsentPut:[OrderedCollection new]) add: aClass.
		].
	].
	(pkgDeps removeKey: pkgName ifAbsent:[#()]) 
		do:[:aClass| classDeps removeKey: aClass ifAbsent:[]].
	pkgList do:[:pkg|
		self assert: (pkgDeps includesKey: pkg)
			description: pkgName, ' no longer depends on ', pkg.
		(pkgDeps removeKey: pkg ifAbsent: [#()]) 
			do:[:aClass| classDeps removeKey: aClass ifAbsent:[]].
	].
	classDeps keysAndValuesDo:[:class :deps|
		Transcript cr; show: class name, ' dependencies:'.
		deps do:[:each| Transcript crtab; show: each].
	].
	self assert: pkgDeps isEmpty
		description: pkgName, ' now depends on ', pkgDeps.
!

----- Method: ST80PackageDependencyTest>>testST80 (in category 'as yet unclassified') -----
testST80
	self testPackage: 'ST80' dependsExactlyOn: #(
		Collections
		Compiler
		Files
		Graphics
		Kernel
		Morphic
		Multilingual
		Network
		SUnit
		System
		'ToolBuilder-Kernel'
		Tools
	).!



More information about the Squeak-dev mailing list