The Trunk: ToolsTests-mt.93.mcz

Marcel Taeumel uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-mt.93.mcz

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

Name: ToolsTests-mt.93
Author: mt
Time: 7 October 2019, 10:19:02.873231 am
UUID: 72393ce3-41cc-b745-a0ab-790111f84f30
Ancestors: ToolsTests-pre.92

Complements System-mt.1112, which fixes and clean-up in the debugger infrastructure:

- Adds several debugger tests (Morphic only!)
- Fixes that debugger-unwind test

=============== Diff against ToolsTests-pre.92 ===============

Item was added:
+ TestCase subclass: #DebuggerTests
+ instanceVariableNames: 'process debugger window reset'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Debugger'!
+
+ !DebuggerTests commentStamp: 'mt 10/1/2019 14:24' prior: 0!
+ You must be in a Morphic project to run these tests!! Note that *ALL* tests construct new processes and leave the current UI process as is. Even errors are injected in helper processes. So, the test runner will not suspend or terminate when running these tests.
+
+ Note that many of these tests depend on the StandardToolSet. So, if you have a custom tool set, maybe reset it first.!

Item was added:
+ ----- Method: DebuggerTests>>doTestUserInterruptFor:priority: (in category 'support') -----
+ doTestUserInterruptFor: block priority: priority
+ "Note that we cannot signal the InterruptSemaphore because there is already the regular process waiting for it. We simulate that semaphore with a custom delay."
+
+ | work wait interruptHelper |
+ work := Semaphore new.
+ wait := Semaphore new. "Maybe not necessary?"
+
+ process := [ work wait. block value ] newProcess.
+ process priority: priority.
+ self assert: process priority >= Processor activeProcess priority. "You cannot interrupt lower priority processes."
+ process resume.
+
+ interruptHelper := [ wait wait. 10 milliSeconds wait. Smalltalk handleUserInterrupt ] newProcess.
+ interruptHelper priority: Processor lowIOPriority.
+ self assert: interruptHelper priority > process priority.
+ interruptHelper resume.
+
+ [wait signal. work signal] valueNoContextSwitch.
+ process priority = Processor activeProcess priority ifTrue: [Processor yield].
+
+ self assert: interruptHelper isTerminated.
+
+ self ensureDebugger.!

Item was added:
+ ----- Method: DebuggerTests>>ensureDebugger (in category 'support') -----
+ ensureDebugger
+
+ debugger ifNotNil: [debugger close].
+
+ debugger := nil.
+ window := nil.
+
+ self assert: process notNil.
+ self assert: process isSuspended.
+
+ self findDebugger.
+
+ self assert: window notNil.
+ self assert: debugger notNil.!

Item was added:
+ ----- Method: DebuggerTests>>findDebugger (in category 'support') -----
+ findDebugger
+
+ window := nil.
+ debugger := nil.
+
+ self findDebuggerWindowFor: process.
+
+ window ifNil: [
+ self updateUserInterface.
+ self findDebuggerWindowFor: process].
+
+ window ifNotNil: [debugger := window model]!

Item was added:
+ ----- Method: DebuggerTests>>findDebuggerWindowFor: (in category 'support') -----
+ findDebuggerWindowFor: process
+
+ window :=  (Project current world in: [:world | world submorphs, world firstHand submorphs])
+ detect: [:m | (m isSystemWindow and: [m model isKindOf: Debugger]) and: [m model interruptedProcess == process]]
+ ifNone: [].!

Item was added:
+ ----- Method: DebuggerTests>>installToolSet (in category 'support') -----
+ installToolSet
+
+ ToolSet default: DebuggerTestsToolSet new.!

Item was added:
+ ----- Method: DebuggerTests>>setUp (in category 'running') -----
+ setUp
+
+ super setUp.
+
+ Project current isMorphic ifFalse: [self fail].
+ Project current uiProcess isActiveProcess ifFalse: [self fail].
+
+ reset := {
+ [:enable | [enable ifTrue: [Preferences enable: #logDebuggerStackToFile]]]
+ value: Preferences logDebuggerStackToFile.
+ [:ts | [ToolSet default: ts]]
+ value: ToolSet default.
+ }.
+
+ Preferences disable: #logDebuggerStackToFile.!

Item was added:
+ ----- Method: DebuggerTests>>tearDown (in category 'running') -----
+ tearDown
+
+ debugger ifNotNil: [debugger close].
+ process ifNotNil: [process terminate].
+
+ process := nil.
+ debugger := nil.
+ window := nil.
+
+ reset do: #value.
+
+ super tearDown.!

Item was added:
+ ----- Method: DebuggerTests>>test01UserInterrupt (in category 'tests') -----
+ test01UserInterrupt
+
+ | counter |
+ {
+ [ [counter := counter + 1] repeat ].
+ [ [counter := counter + 1. true] whileTrue ].
+ "[ counter := counter + 1. Smalltalk createStackOverflow ]." "Disabled because VM may actually crash under certain conditions."
+ } do: [:workBlock |
+ {
+ Processor userSchedulingPriority.
+ Processor userSchedulingPriority + 1.
+ Processor userInterruptPriority
+ } do: [:workPriority |
+ counter := 0.
+ self doTestUserInterruptFor: workBlock priority: workPriority.
+ self assert: counter > 0.
+ self assert: debugger isNotifier]].!

Item was added:
+ ----- Method: DebuggerTests>>test02UnhandledException (in category 'tests') -----
+ test02UnhandledException
+
+ | counter |
+ {
+ [ counter := counter + 1. 7/0 ]. 'ZeroDivide'.
+ [ counter := counter + 1. Halt signal ]. 'Halt'.
+ [ counter := counter + 1. Warning signal: 'Test' ]. 'Warning'
+ } pairsDo: [:errorBlock :label |
+ Processor systemBackgroundPriority
+ to: Processor timingPriority
+ by: 10
+ do: [:priority |
+ counter := 0.
+
+ process := errorBlock forkAt: priority.
+
+ "Let lower priority processes run to raise their exception."
+ priority <= Processor activeProcess priority ifTrue: [
+ 3 timesRepeat: [process isSuspended not ifTrue: [50 milliSeconds wait]]].
+
+ self ensureDebugger.
+
+ self assert: counter > 0.
+ self assert: (window label beginsWith: label).
+ self assert: debugger isNotifier]]!

Item was added:
+ ----- Method: DebuggerTests>>test03AsyncronousExceptions (in category 'tests') -----
+ test03AsyncronousExceptions
+ "We want to get n different debuggers from n different processes."
+
+ ((1 to: 3) "... more than 1 ... so ... 3 sounds about right ..."
+ collect: [:inc | [ Error signal ] forkAt: Processor userSchedulingPriority + inc])
+ do: [:errorProcess |
+ "There must be debuggers for all processes."
+ process := errorProcess.
+ self ensureDebugger];
+ in: [:all | debugger close "Just close the last debugger."];
+ do: [:errorProcess |
+ process := errorProcess.
+ self findDebugger.
+
+ self assert: debugger isNil.
+ self assert: process isTerminated]!

Item was added:
+ ----- Method: DebuggerTests>>test04DebuggerSuspendsProcess (in category 'tests') -----
+ test04DebuggerSuspendsProcess
+ "Opening the debugger on a running process means to suspend that process."
+
+ process := [ [3 + 4] repeat ] newProcess.
+
+ "Choose a priority lower than the active process so that we can use an endless loop."
+ process priority: Processor activeProcess priority - 1.
+ process resume. Processor yield.
+
+ self deny: process isSuspended.
+
+ debugger := process debug.
+
+ self assert: process isSuspended.!

Item was added:
+ ----- Method: DebuggerTests>>test05DebuggerTerminatesProcess (in category 'tests') -----
+ test05DebuggerTerminatesProcess
+ "Closing a debugger on a suspended process means terminating that process."
+
+ process := [ [3 + 4] repeat ] newProcess.
+
+ "Choose a priority lower than the active process so that we can use an endless loop."
+ process priority: Processor activeProcess priority - 1.
+ process resume. Processor yield.
+
+ self deny: process isTerminated.
+
+ debugger := process debug.
+ debugger close.
+
+ self assert: process isTerminated.!

Item was added:
+ ----- Method: DebuggerTests>>test06DebugSpecificContext (in category 'tests') -----
+ test06DebugSpecificContext
+
+ | context |
+
+ process := [ #(1 2 3) collect: [:ea | ea odd ifTrue: [ ea ] ifFalse: [ Processor activeProcess suspend ] ] ] newProcess.
+ process priority: Processor activeProcess priority + 1.
+ process resume.
+
+ "Find specific context by following #sender chain."
+ context := process suspendedContext.
+ [context selector = #collect: ] whileFalse: [context := context sender].
+
+ debugger := process debug: context.
+
+ self assert: debugger contextStackTop = context.!

Item was added:
+ ----- Method: DebuggerTests>>test07DebuggerNotifier (in category 'tests') -----
+ test07DebuggerNotifier
+
+ process := [ 3+4 ] newProcess.
+ debugger := process debugWithTitle: 'Test' full: false.
+ self assert: debugger isNotifier.!

Item was added:
+ ----- Method: DebuggerTests>>test08DebuggerFull (in category 'tests') -----
+ test08DebuggerFull
+
+ process := [ 3+4 ] newProcess.
+ debugger := process debugWithTitle: 'Test' full: true.
+ self assert: debugger isFull.!

Item was added:
+ ----- Method: DebuggerTests>>test09DebuggerNotifierOrFull (in category 'tests') -----
+ test09DebuggerNotifierOrFull
+ "Test the defaults."
+
+ process := [ 3+4 ] newProcess.
+ debugger := process debug.
+ self assert: debugger isFull.
+
+ debugger close.
+
+ process := [ 3+4 ] newProcess.
+ debugger := process debugWithTitle: 'Test'.
+ self assert: debugger isFull.
+
+ debugger close.
+
+ process := [ 3+4 ] newProcess.
+ debugger := process debug: process suspendedContext.
+ self assert: debugger isNotifier.!

Item was added:
+ ----- Method: DebuggerTests>>test10DebugBlock (in category 'tests') -----
+ test10DebugBlock
+ "Used for debug-it in tools."
+
+ process := Process forBlock: [3+4].
+ debugger := process debug.
+
+ self deny: 7 equals: process suspendedContext top.
+ debugger stepOver.
+ self assert: 7 equals: process suspendedContext top.!

Item was added:
+ ----- Method: DebuggerTests>>test11DebugBlockAtContext (in category 'tests') -----
+ test11DebugBlockAtContext
+ "Similar to the run-to feature in the debugger, run the process until a certain condition is met."
+
+ process := Process
+ forBlock: [(#(1 2 3) collect: [:ea | ea + 1]) in: [:all | all sum]]
+ runUntil: [:context | context selector = #sum].
+ debugger := process debug.
+
+ self deny: 9 equals: process suspendedContext top.
+ debugger stepOver.
+ self assert: 9 equals: process suspendedContext top.!

Item was added:
+ ----- Method: DebuggerTests>>test12ToolSetHandleError (in category 'tests') -----
+ test12ToolSetHandleError
+ "Test whether the #handle* callback is reached as expected."
+
+ self installToolSet.
+
+ process := [ Error signal ] newProcess.
+ process priority: Processor userSchedulingPriority + 1.
+
+ self assert: 0 equals: self toolSet handledErrors size.
+ process resume.
+ self assert: 1 equals: self toolSet handledErrors size.!

Item was added:
+ ----- Method: DebuggerTests>>test13ToolSetHandleWarning (in category 'tests') -----
+ test13ToolSetHandleWarning
+ "Test whether the #handle* callback is reached as expected."
+
+ self installToolSet.
+
+ process := [ Warning signal ] newProcess.
+ process priority: Processor userSchedulingPriority + 1.
+
+ self assert: 0 equals: self toolSet handledWarnings size.
+ process resume.
+ self assert: 1 equals: self toolSet handledWarnings size.!

Item was added:
+ ----- Method: DebuggerTests>>test14ToolSetHandleUserInterruptRequest (in category 'tests') -----
+ test14ToolSetHandleUserInterruptRequest
+ "Test whether the #handle* callback is reached as expected."
+
+ self installToolSet.
+
+ process := [ Smalltalk handleUserInterrupt ] newProcess.
+ process priority: Processor userSchedulingPriority + 1.
+
+ self assert: 0 equals: self toolSet handledUserInterruptRequests size.
+ process resume.
+ self assert: 1 equals: self toolSet handledUserInterruptRequests size.!

Item was added:
+ ----- Method: DebuggerTests>>test15ToolSetDebugProcess (in category 'tests') -----
+ test15ToolSetDebugProcess
+ "Test whether the #debug* callback is reached as expected."
+
+ self installToolSet.
+
+ process := [ 3+4 ] newProcess.
+
+ self assert: 0 equals: self toolSet debuggedProcesses size.
+ process debug.
+ self assert: 1 equals: self toolSet debuggedProcesses size.!

Item was added:
+ ----- Method: DebuggerTests>>toolSet (in category 'support') -----
+ toolSet
+
+ ^ ToolSet default!

Item was added:
+ ----- Method: DebuggerTests>>updateUserInterface (in category 'support') -----
+ updateUserInterface
+
+ Project current world doOneCycle.!

Item was added:
+ StandardToolSet subclass: #DebuggerTestsToolSet
+ instanceVariableNames: 'data'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Debugger'!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
+ debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
+
+ (data at: #debuggedProcesses ifAbsentPut: [OrderedCollection new])
+ add: aProcess.
+
+ aProcess suspend.!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>doesNotUnderstand: (in category 'error handling') -----
+ doesNotUnderstand: aMessage
+
+ aMessage numArgs = 0
+ ifTrue: [^ data at: aMessage selector ifAbsent: [{}]].
+
+ (self class respondsTo: aMessage selector)
+ ifTrue: [^ aMessage sendTo: self class].
+
+ ^ super doesNotUnderstand: aMessage!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>handleError: (in category 'debugging - handlers') -----
+ handleError: anError
+
+ (data at: #handledErrors ifAbsentPut: [OrderedCollection new])
+ add: anError.
+
+ Processor activeProcess suspend.!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>handleUserInterruptRequest: (in category 'debugging - handlers') -----
+ handleUserInterruptRequest: aString
+
+ (data at: #handledUserInterruptRequests ifAbsentPut: [OrderedCollection new])
+ add: aString.!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>handleWarning: (in category 'debugging - handlers') -----
+ handleWarning: aWarning
+
+ (data at: #handledWarnings ifAbsentPut: [OrderedCollection new])
+ add: aWarning.
+
+ Processor activeProcess suspend.!

Item was added:
+ ----- Method: DebuggerTestsToolSet>>initialize (in category 'initialize-release') -----
+ initialize
+
+ super initialize.
+ data := Dictionary new.!

Item was changed:
  ----- Method: DebuggerUnwindBug>>testUnwindDebugger (in category 'tests') -----
  testUnwindDebugger
  "test if unwind blocks work properly when a debugger is closed"
  | sema process debugger top |
  sema := Semaphore forMutualExclusion.
  self assert: sema isSignaled.
  process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority.
  self deny: sema isSignaled.
 
  "everything set up here - open a debug notifier"
+ debugger := process debugWithTitle: 'test' full: false.
- debugger := Debugger openInterrupt: 'test' onProcess: process.
  "get into the debugger"
  debugger debug.
  top := debugger topView.
  "set top context"
  debugger toggleContextStackIndex: 1.
  "close debugger"
  top delete.
 
  "and see if unwind protection worked"
  self assert: sema isSignaled.!