help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH 2/2] scripts: Add -d/--debug handling to gst-sun


From: Holger Hans Peter Freyther
Subject: [Help-smalltalk] [PATCH 2/2] scripts: Add -d/--debug handling to gst-sunit
Date: Fri, 24 Jan 2014 20:25:30 +0100

In case a test is failing due an unhandled exception or a test
failure occurs VisualGST will be loaded and the situation can
be analyzed. This should help during development/porting the
only downside is the load time of the VisualGST package.

2014-01-24  Holger Hans Peter Freyther <address@hidden>

        * scripts/Test.st: Add -d/--debug option parsing.
---
 ChangeLog       |  4 ++++
 NEWS            |  3 +++
 scripts/Test.st | 55 +++++++++++++++++++++++++++++++++++++------------------
 3 files changed, 44 insertions(+), 18 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index eac1c84..44ec2cb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2014-01-24  Holger Hans Peter Freyther <address@hidden>
+
+       * scripts/Test.st: Add -d/--debug option parsing.
+
 2014-01-24  Paolo Bonzini  <address@hidden>
 
        * kernel/Delay.st: Check the Semaphore before queuing the
diff --git a/NEWS b/NEWS
index d77aecf..bb33a80 100644
--- a/NEWS
+++ b/NEWS
@@ -23,6 +23,9 @@ o   VisualGST now understands the CTRL + . shortcut. This 
will flush the
     internal TaskQueue. This might be handy when the debugger is getting
     stuck.
 
+o   gst-sunit now understands the -d/--debug parameter. In case of an
+    unhandled exception or a test failure VisualGST will be spawned.
+
 -----------------------------------------------------------------------------
 
 NEWS FROM 3.2.4 to 3.2.5
diff --git a/scripts/Test.st b/scripts/Test.st
index 4980bb6..770ca62 100644
--- a/scripts/Test.st
+++ b/scripts/Test.st
@@ -37,16 +37,9 @@ Object subclass: SUnitUnhandledDebugger [
     LoadedDebugger := nil.
 
     SUnitUnhandledDebugger class >> open: aString [
-        LoadedDebugger ifNil: [
-            LoadedDebugger := true.
-            PackageLoader fileInPackage: 'VisualGST'.
-
-            [
-                ((Smalltalk at: #VisualGST) at: #TaskQueue) uniqueInstance run.
-                ((Smalltalk at: #GTK) at: #Gtk) main] fork.
-              
-            ((Smalltalk at: #VisualGST) at: #GtkDebugger) open: aString.
-        ].
+        Transcript nextPutAll: 'Unhandled exception. Loading debugger.'; nl.
+        self loadVisualGST.
+        ((Smalltalk at: #VisualGST) at: #GtkDebugger) open: aString.
     ]
 
     SUnitUnhandledDebugger class >> debuggerClass [
@@ -57,17 +50,37 @@ Object subclass: SUnitUnhandledDebugger [
         ^0
     ]
 
-    SUnitUnhandledDebugger class >> checkKeepRunning [
-        LoadedDebugger ifNotNil: [Semaphore new wait]
+    SUnitUnhandledDebugger class >> loadVisualGST [
+        LoadedDebugger ifNotNil: [^self].
+
+        LoadedDebugger := true.
+        PackageLoader fileInPackage: 'VisualGST'.
+
+        "Start the event-loop and avoid scope look-ups. This is why
+        we look-up the class by hand."
+        [
+            ((Smalltalk at: #VisualGST) at: #TaskQueue) uniqueInstance run.
+            ((Smalltalk at: #GTK) at: #Gtk) main
+        ] fork.
+    ]
+
+    SUnitUnhandledDebugger class >> keepRunningOnFailure [
+        "Check if we have loaded the debugger and then just keep running."
+        LoadedDebugger ifNotNil: [self keepRunning]
+    ]
+
+    SUnitUnhandledDebugger class >> keepRunning [
+        Semaphore new wait
     ]
 ]
 
 
 PackageLoader fileInPackage: 'SUnit'!
 
-| helpString verbose script suite result quiet |
+| helpString verbose script suite result quiet debug |
 quiet := false.
 verbose := false.
+debug := false.
 FileStream verbose: false.
 script := ''.
 
@@ -116,6 +129,7 @@ Smalltalk
        FileStream verbose: false ].
 
     opt = 'debug' ifTrue: [
+        debug := true.
         Behavior compile: 'debuggerClass [ ^SUnitUnhandledDebugger]'
     ].
 
@@ -154,8 +168,13 @@ FileStream verbose: false.
        ObjectMemory quit: 1 ].
 
 result := TestSuitesScripter run: script quiet: quiet verbose: verbose.
-
-SUnitUnhandledDebugger checkKeepRunning.
-
-result runCount = result passedCount
-    ifFalse: [ ObjectMemory quit: 1 ]!
+SUnitUnhandledDebugger keepRunningOnFailure.
+
+result runCount = result passedCount ifFalse: [
+    debug ifTrue: [
+        Transcript nextPutAll: 'Tests failed. Loading graphicsl environment.'; 
nl.
+        SUnitUnhandledDebugger loadVisualGST.
+        result gtkInspect.
+        script gtkInspect.
+        SUnitUnhandledDebugger keepRunning].
+    ObjectMemory quit: 1 ]!
-- 
1.8.5.2




reply via email to

[Prev in Thread] Current Thread [Next in Thread]