MinitestUI.ns

Newspeak3
'Root'
class MinitestUI usingPlatform: p minitest: mt ide: devEnv 
(* :exemplar: ide minitestUI *)
= (
	(* Hopscotch UI for unit testing using Minitest. *)
	|
	private List = p collections List.
	private Map = p collections Map.
    private Set = p collections Set.
    private Holder = p hopscotch ducts Holder.
	private Promise = p actors Promise.
	private Color = p graphics Color.
	private Gradient = p hopscotch Gradient.
	private Presenter = p hopscotch Presenter.
	private Subject = p hopscotch Subject.

	private TestCatalog = mt TestCatalog.

	private AssortedMethodsPresenter = devEnv browsing AssortedMethodsPresenter.
    private AssortedMethodsSubject = devEnv browsing AssortedMethodsSubject.

	private MethodSubject = devEnv browsing MethodSubject.
    private MethodPresenter = devEnv browsing MethodPresenter.
    private MethodModel = devEnv browsing MethodModel.
	private ProgrammingPresenter = devEnv browsing ProgrammingPresenter.
	private ProgrammingSubject = devEnv browsing ProgrammingSubject.
    
    private Utilities = devEnv browsing Utilities.

	private ide = devEnv.
	private platform = p.
	private minitest = mt.
	|
) (
class TestResultListPresenter onSubject: s = AssortedMethodsPresenter onSubject: s (
(* A presenter for a list of TestResults, such as a list of successes or failures of a test run. *)
) (
public isKindOfTestResultListPresenter ^ <Boolean> = (
	^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfTestResultListPresenter
)
runAll = (
	sendUp respondToRunAll: content presenters
)
contentPresenters ^ <Collection[TestResultPresenter]> = (
	| sortedTestResults |
	sortedTestResults:: subject resultSubjects sort: 
    [:a :b |  Utilities lexicallyLessOrEqual: a model testCase selector than: b model testCase selector].
	^sortedTestResults collect:
		[:each <TestResultSubject> | each presenter showIndicatorBar: false]
)
elementDescription ^ <String> = (
  ^'test methods'
)
listDescription ^ <String> = (
  ^'test result list methods'
)
) : (
)
class TestResultListSubject onModel: list <List[TestResult]> = ProgrammingSubject onModel: list (
(* The subject of a list of test results, such as a list of successes or failures of a test run. The model is a list of TestResult instances. 
   The subject is stateful. It maintains a cached list of TestResultSubjects for its results. The requirement for this state is driven by the desire to display test results with the corrresponding test method, and the test method presented should have a live exemplar and a stateful evaluator associated with it.  
   
   The results themselves may change for various reasons - test methods may be added, removed or modified, and the test results themselves may change over time as test pass or fail as the codebase is modified. Modifying the model, that is result list itself, is the responsibility of the TestOutcomeSubject that manages the various test result lists. 
   
Clients access the cache via the method resultSubjects, which takes care maintain the cache held in the resultSubjects_slot. It derives the result subjects  from the results, and this list is updated as the underlying model changes.
   
*)
  | resultSubjects_slot <List[TestResultSubject]> |
) (
public createPresenter = (
	^TestResultListPresenter onSubject: self
)
public isEmpty ^ <Boolean> = (
	^model isEmpty
)
public isKindOfTestResultListSubject ^ <Booelan> = (
  ^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfTestResultListSubject
)
public results ^ <List[TestResult]> = (
	^model
)
public resultSubjects ^ <List[TestResultSubject]> = (
	(* Answer a collection of subjects on individual elements of the group which is our subject. *)
    resultSubjects_slot isNil ifTrue: [
     (* First access - initialize the cache and return it *)
	 resultSubjects_slot::  results collect: [:each | TestResultSubject onModel: each].
     ^resultSubjects_slot
     ].
   (* Cache already exists. Make sure it is up to date. *)
   updateResults.
   ^resultSubjects_slot
)
updateResults = (
(* Ensure that the the cached result subjects are in sync with the model. This method must only be called after the cache is first populated, and it should be called on every subsequent attempt to access the result subjects cache. *)
  |
  (* Cached results *)
  subjectResults <List[TestResult]> = resultSubjects_slot collect: [:e <Subject> | e model].
  (* A list of subjects that are obsolete - they are no longer part of the model *)
  obsoleteSubjects <List[TestResultSubject]> = List new.
  |
  (* Gather obsolete results *)
  resultSubjects_slot do: [:s <TestResultSubject> |
    (results includes: s model) ifFalse: [obsoleteSubjects add: s].
  ].
  (* Clean out obsolete entries from cache *)
  obsoleteSubjects do: [:s <TestResultSubject> | resultSubjects_slot remove: s].
  (* Add missing model entries to cache. We keep subjectResults as a separate list so we don't traverse the cache while mutating it. *)
  results do: [:m <TestResult> |
    (subjectResults includes: m) ifFalse: [
      resultSubjects_slot add: (TestResultSubject onModel: m)
      ].
  ].
)
) : (
)
class TestResultPresenter onSubject: s = ProgrammingPresenter onSubject: s (
(* Shows a single TestResult as an expandable selector of the method defining the test. If the result is a failure, also shows the description of the failure. *)
|
	public showIndicatorBar <Boolean> ::= true.
	methodPresenterSlot <MethodPresenter>
|) (
ancestorTestingOutcomePresenter = (
	| ancestor ::= parent. |
	[nil = ancestor] whileFalse:
		[ancestor isKindOfTestingOutcomePresenter ifTrue:
			[^ancestor].
		 ancestor:: ancestor parent].
	^nil
)
public collapse = (
	methodPresenter collapse
)
definition ^ <Fragment> = (
	^showIndicatorBar
		ifTrue: [row: {indicatorBar. elastic:: resultColumn}]
		ifFalse: [resultColumn]
)
exceptionFragment ^ <Fragment> = (
	| link |
	link::
		(link: subject exception printString
		action: [ancestorTestingOutcomePresenter runWithNoExceptionHandling: subject testCase])
			color: footnoteColor.
	^row: {
		blank: 12.
		elastic: link.
		}
)
public expand = (
	methodPresenter expand
)
failureFragment ^ <Fragment> = (
	^row: {
		blank: 12.
		(link: subject failureDescription
		action: [ancestorTestingOutcomePresenter runToDebugFailure: subject testCase])
			color: footnoteColor
		}
)
footnoteColor ^ <Color> = (
	^Color gray: 0.7
)
indicatorBar = (
	^(row: {blank: 5} ) color: statusColor.
)
public isKindOfTestResultPresenter ^ <Boolean> = (
  ^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfTestResultPresenter
)
methodPresenter ^ <ExpandableMethodPresenter> = (
      methodPresenterSlot isNil ifTrue: [
	   methodPresenterSlot:: subject methodSubject createPresenter showClassName: true
	].
      ^methodPresenterSlot
)
resultColumn ^ <Fragment> = (
	^column: {
		methodPresenter.
		subject isFailure ifTrue: [failureFragment] ifFalse: [nothing].
		subject hasException ifTrue: [exceptionFragment] ifFalse: [nothing].
		(* subject hasNoData ifTrue: [noDataFragment] *)
	}
)
statusColor ^ <Color> = (
	(* subject passed ifTrue: [^Color green].
	subject failed ifTrue: [^Color red].
	subject error ifTrue: [^Color black]. *)
	^Color gray.
)
public tag ^ <String> = (
  ^methodPresenter tag
)
updateVisualsFromSameKind: oldPresenter <Self> ^ <Alien[Element]> = (
  showIndicatorBar:: oldPresenter showIndicatorBar.
  substanceSlot:: nil.
  ensureSubstance.
  ^super updateVisualsFromSameKind: oldPresenter
)
) : (
)
class TestResultSubject onModel: m <TestResult> = Subject onModel: m (
(* The subject for presenting a single TestResult. *)
  | methodSubject_slot <MethodSubject> |
) (
classDeclarationMirror = (
	^testCase environment classDeclarationMirror
)
public exception = (
	(* If the model is a test error, return the exception associated with the result. Otherwise return nil. *)
	^model isError
		ifTrue: [model exception]
		ifFalse: [nil]
)
public failureDescription ^<String> = (
	(* If the model is a failure, return the description of the failure. Otherwise return an empty string. *)
	^isFailure
		ifTrue: [model description]
		ifFalse: ['']
)
public hasException ^<Boolean> = (
	(* True if the test result has an exception associated with it, or in other words, the result is a test error. *)
	^model isError
)
public hash = (
	^selector hash * 37 + className hash
)
public isFailure = (
	^model isFailure
)
public isKindOfTestResultSubject ^ <Boolean> = (
  ^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfTestResultSubject
)
public selector ^ <Symbol> = (
	^testCase selector
)
public testResult ^ <TestResult> = (
  ^model
)
public testCase = (
	^testResult testCase
)
public createPresenter ^ <TestResultPresenter> = (
  ^TestResultPresenter onSubject: self
)
public = x <Object> ^ <Boolean> = (
	x isKindOfTestResultSubject ifFalse: [^false].
	^selector = x selector and: [className = x className]
)
public className = (
 (* really should use qualified name *)
#BOGUS.
	^classDeclarationMirror name
)
public methodSubject = (
    methodSubject_slot isNil ifTrue: [
	  methodSubject_slot:: TestMethodSubject onModel: (testCaseToMethod: testCase) 
    ].
    ^methodSubject_slot
)
) : (
)
class TestingInProgressPresenter onSubject: subject = Presenter onSubject: subject (
(* Presents a Tester in the process of running tests. *)
|
	progress <Holder> = Holder with: 0.0.  
	currentSelector
	errorCountHolder
	failureCountHolder
|) (
definition = (
	schedule: [startTests].

	errorCountHolder:: holder: [nothing].
	failureCountHolder:: holder: [nothing].
	currentSelector:: label: 'no tests yet'.	
	^column: {
        progressBar: progress.
		row: {label: 'Running '. currentSelector . label: '...'}.
		errorCountHolder.
		failureCountHolder.
	}
)
public isKindOfTestingInProgressPresenter ^ <Boolean> = (
  ^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfTestingInProgressPresenter
)
public isTransient = (
	(* Should not be recorded in navigation history. *)
	^true
)
pumpTests = (
	tester atEnd ifTrue: [
        tester haveAllTestsSucceeded ifTrue: [tester cleanUp].
        enterSubject:: TestingOutcomeSubject tester: tester configClass: subject configClass.
        ^self
    ].

	currentSelector text: tester peekSelector.
	(failureCountHolder hasVisual and: [tester failures size > 0]) ifTrue:
		[failureCountHolder content: (row: {label: 'Failures: ', tester failures size asString})].
	(errorCountHolder hasVisual and: [tester errors size > 0]) ifTrue:
		[errorCountHolder content: (row: {label: 'Errors: ', tester errors size asString})].

    progress value: tester completedRatio.

	schedule:
		[Promise when: tester stepAsync fulfilled: [pumpTests]].
)
startTests = (
	tester prepare.
	pumpTests.
)
tester ^ <Tester> = (
	^subject tester
)
) : (
)
public class TestingInProgressSubject tester: tester <Tester> configClass: configClass = Subject onModel: tester (
(* Represents a Tester instance, in the process of running tests. *)
|
	public configClass = configClass.
|) (
public isKindOfTestingInProgressSubject ^ <Boolean> = (
  ^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfTestingInProgressSubject
)
public tester ^ <Tester> = (
	^model
)
public title ^ <String> = (
	^'Running Tests'
)
public refreshmentSubject ^ <TestingInProgressSubject> = (
	^self class tester: model configClass: configClass.
)
public createPresenter ^ <TestingInProgressPresenter> = (
	^TestingInProgressPresenter onSubject: self
)
) : (
public onConfiguration: configClass <Class> platform: platform minitest: minitest = (
	| config modules tester |
	config:: configClass packageTestsUsing: ide namespacing manifest.
	modules:: config testModulesUsingPlatform: platform minitest: minitest.
	tester:: minitest Tester testModules: modules.
	^self tester: tester configClass: configClass.
)
)
class TestingOutcomePresenter onSubject: s <TestingOutcomeSubject> = ProgrammingPresenter onSubject: s (
(* Shows an outcome of running a suite of tests, as a page with separate sections for errors, failures and successes. *)
) (
didAllTestsPass = (
	^didNoTestsFail (* not tracking incomplete for now, so no difference from didNoTestsFail *)
)
didNoTestsFail ^ <Boolean> = (
	^subject failures isEmpty and: [subject errors isEmpty]
)
errorsSectionColor = (
	^Gradient from: (Color h: 0 s: 0.15 v: 1) to: (Color h: 0 s: 0.15 v: 0.9)
)
failureHeadingColor = (
	^Gradient from: (Color h: 0 s: 0.5 v: 0.8) to: (Color h: 0 s: 0.5 v: 0.6)
)
failuresSectionColor = (
	^Gradient from: (Color h: 50 s: 0.3 v: 1) to: (Color h: 50 s: 0.3 v: 0.9)
)
headingBlock: fragment color: aColor = (
	^(padded: fragment with: {10. 5. 5. 5}) color: aColor
)
headingDefinition ^ <Presenter> = (
	^(majorHeadingBlock: headingContentsDefinition)
	color: (
		didNoTestsFail
			ifFalse: [failureHeadingColor]
			ifTrue:
				[successHeadingColor])
)
public isKindOfTestingOutcomePresenter ^ <Boolean> = (
	^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfTestingOutcomePresenter
)
public noticeAbandonment = (
	subject tester haveAllTestsSucceeded ifFalse: [subject tester cleanUp].
	super noticeAbandonment.
)
respondToRunAll: testCases = (
(* Run the set of test cases given by testCases.  The UI uses this to re-run just the failures, or errors or successes. However, tests have shared state, which one has to tear down and re-initialize.

Other sections that hold test results should be pointing at different shared state so that they can be re-examined  It doesn't look like things are set up to support this. *)
	halt.
)
successHeadingColor = (
	^Gradient from: (Color h: 120 s: 0.5 v: 0.7) to: (Color h: 120 s: 0.5 v: 0.5)
)
successesSectionColor = (
	^Gradient from: (Color h: 90 s: 0.3 v: 1) to: (Color h: 90 s: 0.3 v: 0.9)
)
sectionHeader: label <String> with: testCases <Collection[TestCase]> status: aSymbol <Symbol> color: aColor <Color | Gradient> ^ <Fragment> = (
	^headingBlock: (row: {
			label: (label, ' (', testCases size printString, ')') (*asText allBold *).
			largeBlank.
			(* (link: 'run all' action: [testedMethodsPresenter runAll]) tinyFont. *)
			filler.
		}) color: aColor.
)
public runWithNoExceptionHandling: testCase = (
	| thread <ThreadMirror> |
	thread:: platform mirrors ActivationMirror invokeSuspended:
		[subject tester runWithNoExceptionHandling: testCase].
    thread resume.
	enterSubject:: ide debugging ThreadSubject onModel: thread.
)
testOutcomesMenu = (
	^menuWithLabelsAndActions: {
		{'Inspect Presenter'. [respondToInspectPresenter]}
	}
)
disabledSectionColor = (
	^Gradient from: (Color h: 180 s: 0.3 v: 1) to: (Color h: 180 s: 0.3 v: 0.9)
)
untestedSectionColor = (
	^Gradient from: (Color h: 150 s: 0.3 v: 1) to: (Color h: 150 s: 0.3 v: 0.9)
)
public run: tc <TestCase> = (
  subject tester run: tc
)
respondToRunAgain = (
	| newSubject |
	subject tester cleanUpResults.
	subject tester haveAllTestsSucceeded ifFalse: [subject tester cleanUp].
	newSubject:: TestingInProgressSubject tester: subject model configClass: subject configClass
		(*onConfiguration: subject configClass
		platform: platform
		minitest: minitest*).
	enterSubject: newSubject.
)
public runToDebugFailure: testCase = (
	| thread <ThreadMirror> |
	thread:: platform mirrors ActivationMirror invokeSuspended:
		[subject tester runToDebugFailure: testCase].
    [thread suspendedActivation method name = testCase selector] whileFalse: [
      thread:: thread suspendedActivation stepOut. 
      ].
	enterSubject:: ide debugging ThreadSubject onModel: thread.
)
headingContentsDefinition ^ <Presenter> = (
	| statusMessage |
	statusMessage::
		didAllTestsPass
			ifTrue: ['Passed']
			ifFalse:
				[didNoTestsFail
					ifTrue: ['Incomplete test results']
					ifFalse: ['Failed ']].
	^row: {
		(link: subject configurationName (* asText allBold *)
			action: [browseClass: subject configClass]) color: Color white.
		smallBlank.
		(label: statusMessage (* asText allBold *)) color: Color white.
		filler.
		button: 'Run Again' action: [respondToRunAgain].
(*		smallBlank.
		button: 'Forget' action: [respondToForget] *)
        mediumBlank.
        helpButton.
        mediumBlank.        
        dropDownMenu: [testOutcomesMenu]
		}.
)
definition ^ <Fragment> = (
	^column: {
        helpSection.
	    headingDefinition.
		blank: 2.
		errors.
		blank: 1.
		failures.
		blank: 1.
        disabled.
		blank: 1.
		inactive.
        blank: 1.
		successes.
	}
)
section: label <String> with: testResults <TestResultListSubject> status: aSymbol <Symbol> color: aColor <Color | Gradient> ^ <Fragment> = (
	| testedMethodsPresenter |
	testedMethodsPresenter:: testResults presenter.
	^column: {
		sectionHeader: label with: testResults results status: aSymbol color: aColor.
		blank: 3.
		testedMethodsPresenter.
	}
)
failures ^ <Fragment> = (
	^section: 'Failures'
		with: subject failureSubjects
		status: #failure
		color: failuresSectionColor
)
errors ^ <Fragment> = (
	^section: 'Errors'
		with: subject errorSubjects
		status: #error
		color: errorsSectionColor
)
inactive ^ <Fragment> = (
	^column: {
		sectionHeader: 'Untested' with: subject inactiveSubjects elements status: #untested color: untestedSectionColor.
		blank: 3.
		subject inactiveSubjects presenter.
	}
)
disabled ^ <Fragment> = (
	^column: {
		sectionHeader: 'Disabled' with: subject disabledSubjects elements status: #disabled color: disabledSectionColor.
		blank: 3.
		subject disabledSubjects presenter.
	}
)
successDetailsLink = (
  ^	subject successSubjects results isEmpty ifFalse:
				[(link: 'Show details...'
				action: [updateGUI: [subject showSuccesses: true]]) (*tinyFont*)]
                ifTrue: [nothing]
)
successes ^ <Fragment> = (
  ^subject showSuccesses ifTrue: [
	section: 'Successes'
		with: subject successSubjects
		status: #success
		color: successesSectionColor
	] ifFalse: [
	column: {
		sectionHeader: 'Successes'
		with: subject successSubjects results
		status: #success
		color: successesSectionColor.
	      row: {
			blank: 10.
			successDetailsLink
		    }
		}
	]
)
helpText ^ <Fragment> = (
  | mapping = Map new. |
  mapping 
      at: #runAgainButton put: (button: 'Run Again' action: [respondToRunAgain]);   
      at: #hopscotchHelpButton put: helpButton;
      at: #testOutcomesMenuButton put: (dropDownMenu: [testOutcomesMenu]);
      at: #successDetails put: successDetailsLink.

  ^ampleforth: 'This is a test outcome presenter. It shows the results of running a test suite in a specific test configuration.  
  If the banner at the top of the presenter (directly below this message) is green, all active tests have passed; if it is red, there have been errors; yellow means there have been test failures but no errors.
  <br>
  The presentation is subdivided into sections that show errors, failures and successes, as well as  listing any tests that have not been run, or have been disabled. The <i>Successes</i> section is collapsed by default, as no one cares about your successes - only your errors and failures. Below the <i>Successes</i> section, the link  <div class = "successDetails"></div> allows you to bask in the glory of your successes if you need to.
  <br>
  The methods within sections themselves provide additional affordances to disable/enable or run individual tests etc. See their help sections for further information.
  <br>
  <ul>
  <li> <div class="runAgainButton"> </div> Re-runs the enabled methods in the test suite.</li>
  <li> <div class="hopscotchHelpButton"> </div> Shows this help message.</li>
  <li> <div class="testOutcomesMenuButton"> </div> Opens a menu of additional operations, such as inspecting this presenter.</li>  
  </ul>
  ' mapping: mapping
)
) : (
)
public class TestingOutcomeSubject tester: t <Tester> configClass: c = ProgrammingSubject onModel: t (
|
	public configClass = c.
	public showSuccesses <Boolean> ::= false.
    disabledSubjects_slot <TestResultListSubject>
    errorSubjects_slot <TestResultListSubject>
    failureSubjects_slot <TestResultListSubject>
    inactiveSubjects_slot <AssortedMethodsSubject>
    successSubjects_slot <TestResultListSubject>    
|) (
public configurationName = (
	^configClass name
)
public createPresenter = (
	^TestingOutcomePresenter onSubject: self
)
public isKindOfTestingOutcomeSubject ^ <Boolean> = (
  ^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfTestingOutcomeSubject
)
public refreshmentSubject = (
	^self class tester: tester configClass: configClass
)
public tester ^ <Tester> = (
	^model
)
public title = (
	^'Test Results for ', configurationName
)
public successes ^ <List[TestSuccess]> = (
	^tester successes
)
public failures ^ <List[TestFailure]> = (
	^tester failures
)
public errors ^ <List[TestError]> = (
	^tester errors
)
public activate: t <TestCase | TestResult> = (
  t isKindOfTestResult ifTrue: [
  ] ifFalse: [
    inactive remove: t ifAbsent: [shouldNotHappen]
  ]
)
public enable: tc <TestCase> = (
  tester enable: tc
)
public isEnabled: tc ^ <Boolean> = (
  ^tester isEnabled: tc
)
public disable: tc <TestCase | TestResult> = (
  tester disable: tc
)
public disabled ^ <Collection[TestCase]> = (
  ^tester disabled
)
public inactive ^ <Collection[TestCase]> = (
  ^tester inactive
)
public errorSubjects ^ <TestResultListSubject> = (
  errorSubjects_slot isNil ifTrue: [
    errorSubjects_slot:: TestResultListSubject onModel: tester errors.
    ^errorSubjects_slot
  ].
  updateErrors.
  ^errorSubjects_slot
)
public successSubjects ^ <TestResultListSubject> = (
  successSubjects_slot isNil ifTrue: [
    successSubjects_slot:: TestResultListSubject onModel: tester successes.
    ^successSubjects_slot
  ].
  updateSuccesses.
  ^successSubjects_slot
)
public failureSubjects ^ <TestResultListSubject> = (
  failureSubjects_slot isNil ifTrue: [
    failureSubjects_slot:: TestResultListSubject onModel: tester failures.
    ^failureSubjects_slot
  ].
  updateFailures.
  ^failureSubjects_slot
)
updateErrors = (
  ^Utilities updateSubjects:  [errorSubjects_slot resultSubjects] fromModel: [errors] subjectFactory: TestResultSubject
)
updateFailures = (
  ^Utilities updateSubjects:  [failureSubjects_slot resultSubjects] fromModel: [failures] subjectFactory: TestResultSubject
)
updateSuccesses = (
  ^Utilities updateSubjects:  [successSubjects_slot resultSubjects] fromModel: [successes] subjectFactory: TestResultSubject
)
public disabledSubjects ^ <TestResultListSubject> = (
  disabledSubjects_slot isNil ifTrue: [
    disabledSubjects_slot:: AssortedMethodsSubject onModel: (disabled collect: [:testCase <TestCase> | 
        TestMethodSubject onModel: (testCaseToMethod: testCase)
      ]).
    ^disabledSubjects_slot
  ].
  updateDisabled.
  ^disabledSubjects_slot
)
public inactiveSubjects ^ <AssortedMethodsSubject> = (
  inactiveSubjects_slot isNil ifTrue: [
    inactiveSubjects_slot:: AssortedMethodsSubject onModel: (inactive collect: [:testCase <TestCase> | 
        TestMethodSubject onModel: (testCaseToMethod: testCase)
      ]).    
      ^inactiveSubjects_slot
  ].
  updateInactive.
  ^inactiveSubjects_slot
)
updateDisabled = (
  ^Utilities 
       updateSubjects:  [disabledSubjects_slot elements] 
       fromModel: [disabled collect: [:testCase | testCaseToMethod: testCase]] 
       subjectFactory: TestMethodSubject
)
updateInactive = (
  ^Utilities 
       updateSubjects:  [inactiveSubjects_slot elements] 
       fromModel: [inactive collect: [:testCase | testCaseToMethod: testCase]] 
       subjectFactory: TestMethodSubject
)
) : (
public onConfiguration: configClass <Class> platform: platform minitest: minitest = (
	| config modules tester |
	config:: configClass packageTestsUsing: ide namespacing manifest.
	modules:: config testModulesUsingPlatform: platform minitest: minitest.
	tester:: minitest Tester testModules: modules.
    tester prepare.
	^self tester: tester configClass: configClass.
)
)
class TestMethodPresenter onSubject: s <MethodSubject> = MethodPresenter onSubject: s(
) (
public isKindOfTestMethodPresenter ^ <Boolean> = (
  ^true
)
isMyKind: other ^ <Boolean> = (
  ^other isKindOfTestMethodPresenter
)
ancestorTestingOutcomePresenter = (
	| ancestor ::= parent. |
	[nil = ancestor] whileFalse:
		[ancestor isKindOfTestingOutcomePresenter ifTrue:
			[^ancestor].
		 ancestor:: ancestor parent].
	^nil
)
methodMenuFor: methodName <String> = (
   | 
   superMenu = super methodMenuFor: methodName. 
   menuExtensions =  isEnabled ifFalse: [
     {
        {'enable and run'. [respondToEnableAndRun]}. 
        {'enable'.  [respondToEnable]}
     }
     ] ifTrue: [{ {'run'. [respondToRun] }. {'disable'.  [respondToDisable]}}].
   |
	^superMenu, menuExtensions
)
outcomeSubject ^ <TestingOutcomeSubject> = (
  ^ancestorTestingOutcomePresenter subject
)
isEnabled ^ <Boolean> = (
  ^outcomeSubject isEnabled: test
)
respondToEnable = (
  updateGUI: [outcomeSubject enable: test]
)
respondToDisable = (
  updateGUI: [outcomeSubject disable: test]
)
ancestorResultPresenter = (
	| ancestor ::= parent. |
	[nil = ancestor or: [ancestor isKindOfHopscotchWindow]] whileFalse:
		[ancestor isKindOfTestResultPresenter ifTrue:
			[^ancestor].
		 ancestor:: ancestor parent].
	^nil
)
test ^ <TestCase | TestResult>  = (
 (* Return the testCase or testResult I represent.*)
   | resultPresenter <TestResultPresenter> = ancestorResultPresenter. |
   (* If I represent an failure, error or success, I am embedded
       in a TestResultPresenter.*)
  resultPresenter isNil ifFalse: [ 
    (* Return test result *)
    ^resultPresenter subject testResult
  ].
   (* Otherwise I am disabled or untested *)
   ^outcomeSubject disabled detect: [:tc | tc selector = subject name] ifNone: [
       outcomeSubject inactive detect: [:tc | tc selector = subject name] ifNone: []
       ].
)
respondToRun = (
  |
  t <TestCase | TestResult> = test.
  tc  <TestCase> = t isKindOfTestResult ifTrue: [t testCase] ifFalse: [t].
  |
  updateGUI: [
    outcomeSubject activate: t.
    ancestorTestingOutcomePresenter run: tc
    ]
)
respondToEnableAndRun = (
  |
  t <TestCase | TestResult> = test.
  tc  <TestCase> = t isKindOfTestResult ifTrue: [t testCase] ifFalse: [t].
  |
  updateGUI: [
    outcomeSubject enable: t.
    outcomeSubject activate: t.
    ancestorTestingOutcomePresenter run: tc    
    ]
)
menuHelp ^ <String> = (
  | 
  menuExtensions <String> = isEnabled 
    ifFalse: [
     ', enabling and running the test, or just enabling it without running it'
     ] ifTrue: [
     ', running this test or disabling it'
     ].
  |
   ^super menuHelp, menuExtensions
)
) : (
)
class TestMethodSubject onModel: m <MethodModel>  = MethodSubject onMethodModel: m (

) (
public isKindOfTestMethodSubject ^ <Boolean> = (
  ^true
)
isMyKind: other <Subject> = (
  ^other isKindOfTestMethodSubject
)
public createPresenter ^ <TestMethodPresenter> = (
  ^TestMethodPresenter onSubject: self
)
) : (
)
testCaseToMethod: testCase <TestCase> ^ <MethodModel> = (
  ^MethodModel method: (testCase environment classDeclarationMirror instanceSide methods findMirrorNamed: testCase selector) exemplar: nil
)
) : (
)