--- a/Tools__TestRunner2.st Wed Oct 05 11:57:26 2022 +0100
+++ b/Tools__TestRunner2.st Wed Oct 05 11:34:56 2022 +0100
@@ -1,7 +1,7 @@
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
- Copyright (c) 2021 LabWare
+ Copyright (c) 2021-2022 LabWare
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -68,7 +68,7 @@
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
- Copyright (c) 2021 LabWare
+ Copyright (c) 2021-2022 LabWare
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
@@ -1008,25 +1008,29 @@
<resource: #menu>
^
- #(Menu
- (
+ #(Menu (
+ (MenuItem
+ label: 'Pin runner'
+ itemValue: resultListMenuPin
+ isVisible: true
+ )
(MenuItem
label: 'Browse'
itemValue: resultListMenuBrowse
- translateLabel: true
- )
+ isVisible: true
+ )
(MenuItem
label: '-'
- )
+ isVisible: true
+ )
(MenuItem
label: 'Copy List'
itemValue: resultListMenuCopyList
- translateLabel: true
- )
+ isVisible: true
)
- nil
+ ) nil
nil
- )
+ )
! !
!TestRunner2 class methodsFor:'resources'!
@@ -1574,6 +1578,42 @@
].
].
self window setClipboardText:text
+!
+
+resultListMenuPin
+ | selectedTest suite result suiteAndResult runner |
+
+ selectedTest := self selectedResultHolder value test.
+ suite := TestSuite named: selectedTest selector.
+ suite addTest: selectedTest.
+ result := resultHolder value first. "/selectedTest class rememberedOutcomeFor: selectedTest selector.
+ suiteAndResult := TestRunnerMini::SuiteAndResult suite: suite result: result.
+
+ runner := TestRunnerMini new.
+ runner resultHolder value: suiteAndResult.
+
+ runner allButOpen.
+ runner window beToolWindow.
+ runner open.
+
+
+
+ "/|rslt test cls selector|
+"/
+"/ rslt := self selectedResultHolder value.
+"/ test := rslt test.
+"/ test notNil ifTrue:[
+"/ cls := test class.
+"/ selector := test selector.
+"/ ] ifFalse:[
+"/ cls := Smalltalk classNamed:rslt rawLabel
+"/ ].
+"/
+"/ cls notNil ifTrue:[
+"/ cls browse:selector.
+"/ ].
+
+ "Created: / 05-10-2022 / 11:13:38 / Jan Vrany <jan.vrany@labware.com>"
! !
!TestRunner2 methodsFor:'aspects'!