Tools__TestRunner2.st
branchjv
changeset 19638 f0275261f2ca
parent 19612 9f2e3136aa4d
child 19648 5df52d354504
--- 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'!