Adds clean up of descendant processes.

codeZeilen · codeZeilen · commit 95c2342c6253 · 2023-01-12T09:14:36.000+01:00
diff --git a/packages/Babylonian-Core.package/BPExampleTraceInformation.class/instance/terminateTracingProcess.st b/packages/Babylonian-Core.package/BPExampleTraceInformation.class/instance/terminateTracingProcess.st
@@ -2,5 +2,5 @@ process control
 terminateTracingProcess
 
 	self tracingProcess ifNotNil: [:aTracingProcess | 
-		aTracingProcess isTerminated ifFalse: [
-			aTracingProcess terminate]].
+		{aTracingProcess} , (BPProcessGenealogy allDescendantsOf: aTracingProcess) do: [:p |
+			p isTerminated ifFalse: [p terminate]]].
diff --git a/packages/Babylonian-Core.package/BPExampleTraceInformation.class/methodProperties.json b/packages/Babylonian-Core.package/BPExampleTraceInformation.class/methodProperties.json
@@ -4,7 +4,7 @@
 	"instance" : {
 		"isProcessSuspended" : "joabe 9/28/2022 01:08",
 		"probes" : "jb 5/19/2021 19:35",
-		"terminateTracingProcess" : "pre 1/11/2023 13:32",
+		"terminateTracingProcess" : "pre 1/12/2023 09:06",
 		"trace" : "pre 8/18/2020 08:45",
 		"trace:" : "jb 7/1/2021 23:21",
 		"tracingProcess" : "pre 8/18/2020 08:45",
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/README.md b/packages/Babylonian-Core.package/BPProcessGenealogy.class/README.md
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/allDescendantsOf..st b/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/allDescendantsOf..st
@@ -0,0 +1,12 @@
+accessing
+allDescendantsOf: aProcess
+
+	| next queue result |
+	queue := OrderedCollection newFrom: {aProcess}.
+	result := OrderedCollection new.
+	[queue notEmpty] whileTrue: [ | descendants |
+		next := queue removeFirst.
+		descendants := self directDescendantsOf: next.
+		result addAll: descendants.
+		queue addAll: descendants].
+	^ result reject: [:process | process isNil]
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/directDescendantsOf..st b/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/directDescendantsOf..st
@@ -0,0 +1,4 @@
+accessing
+directDescendantsOf: aProcess
+
+	^ (self processes at: aProcess ifAbsent: [#()]) asArray
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/newProcess.descendsFrom..st b/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/newProcess.descendsFrom..st
@@ -0,0 +1,4 @@
+accessing
+newProcess: newProcess descendsFrom: parentProcess
+
+	(self processes at: parentProcess ifAbsentPut: [WeakSet new]) add: newProcess.
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/processes.st b/packages/Babylonian-Core.package/BPProcessGenealogy.class/class/processes.st
@@ -0,0 +1,4 @@
+accessing
+processes
+
+	^ Processes ifNil: [Processes := WeakKeyDictionary new]
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/methodProperties.json b/packages/Babylonian-Core.package/BPProcessGenealogy.class/methodProperties.json
@@ -0,0 +1,8 @@
+{
+	"class" : {
+		"allDescendantsOf:" : "pre 1/12/2023 09:06",
+		"directDescendantsOf:" : "pre 1/12/2023 08:48",
+		"newProcess:descendsFrom:" : "pre 1/12/2023 08:46",
+		"processes" : "pre 1/12/2023 08:46" },
+	"instance" : {
+		 } }
diff --git a/packages/Babylonian-Core.package/BPProcessGenealogy.class/properties.json b/packages/Babylonian-Core.package/BPProcessGenealogy.class/properties.json
@@ -0,0 +1,14 @@
+{
+	"category" : "Babylonian-Core-Tracing",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		"Processes" ],
+	"commentStamp" : "",
+	"instvars" : [
+		 ],
+	"name" : "BPProcessGenealogy",
+	"pools" : [
+		 ],
+	"super" : "Object",
+	"type" : "normal" }
diff --git a/packages/Babylonian-Core.package/Process.extension/class/forContext.priority..st b/packages/Babylonian-Core.package/Process.extension/class/forContext.priority..st
@@ -18,6 +18,8 @@ forContext: aContext priority: anInteger
 	activeProcess propagatesDynamicVariables ifTrue: [
 		activeProcess setDynamicVariables do: [:dynamicVariable |
 			newProcess environmentAt: dynamicVariable put: (activeProcess environmentAt: dynamicVariable)]].
+	BPProcessGenealogy newProcess: newProcess descendsFrom: activeProcess.
+	
 	"-------------- BP ContextS2 additions end --------------"
 	
 	^newProcess
diff --git a/packages/Babylonian-Core.package/Process.extension/methodProperties.json b/packages/Babylonian-Core.package/Process.extension/methodProperties.json
@@ -1,6 +1,6 @@
 {
 	"class" : {
-		"forContext:priority:" : "pre 1/11/2023 16:16" },
+		"forContext:priority:" : "pre 1/12/2023 08:53" },
 	"instance" : {
 		"dontPropagateCSLayers" : "pre 1/11/2023 15:44",
 		"dontPropagateDynamicVariables" : "pre 1/11/2023 15:52",
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/README.md b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/README.md
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/setUp.st b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/setUp.st
@@ -0,0 +1,4 @@
+tests
+setUp
+
+	preventTerminationSemaphore := Semaphore new.
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/tearDown.st b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/tearDown.st
@@ -0,0 +1,4 @@
+tests
+tearDown
+
+	10 timesRepeat: [preventTerminationSemaphore signal].
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testKeepingTrackOfAllDescendingProcesses.st b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testKeepingTrackOfAllDescendingProcesses.st
@@ -0,0 +1,23 @@
+tests
+testKeepingTrackOfAllDescendingProcesses
+
+	| example traceAndProcess semaphore process1 descendants |
+	example := BPMethodExample new
+		exampleName: 'test example';
+		method: BPTestManuallyInstrumentedClass>>#methodA;
+		yourself.
+	descendants := nil.
+	semaphore := Semaphore new.
+	traceAndProcess := [2+3.
+	process1 := Processor activeProcess.
+	 	[2+3. 
+			[descendants := BPProcessGenealogy allDescendantsOf: process1.
+			semaphore signal.] 
+				forkNamed: 'the third'
+		] forkNamed: 'the second'] bpTraceInBackgroundForExample: example.
+	traceAndProcess second resume.
+	semaphore wait.
+
+	self assert: descendants size = 2.
+	self assert: descendants first name = 'the second'.
+	self assert: descendants second name = 'the third'.
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testProbingAMethodCalledInANewProcess.st b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testProbingAMethodCalledInANewProcess.st
@@ -1,4 +1,4 @@
-tests - concurrent tracing
+tests
 testProbingAMethodCalledInANewProcess
 
 	| example traceAndProcess semaphore |
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testTerminatingAllDescendantProcesses.st b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/instance/testTerminatingAllDescendantProcesses.st
@@ -0,0 +1,30 @@
+tests
+testTerminatingAllDescendantProcesses
+
+	| example traceAndProcess process1 descendants descendantsSetSemaphore preventTerminationSemaphore |
+	example := BPMethodExample new
+		exampleName: 'test example';
+		method: BPTestManuallyInstrumentedClass>>#methodA;
+		yourself.
+	descendants := nil.
+	preventTerminationSemaphore := Semaphore new.
+	descendantsSetSemaphore := Semaphore new.
+	traceAndProcess := [2+3.
+		process1 := Processor activeProcess.
+	 	[2+3. 
+			[descendants := BPProcessGenealogy allDescendantsOf: process1.
+			descendantsSetSemaphore signal.
+			preventTerminationSemaphore wait.] 
+				forkNamed: 'the third'.
+		preventTerminationSemaphore wait.
+		] forkNamed: 'the second'.
+		preventTerminationSemaphore wait.] bpTraceInBackgroundForExample: example.
+	traceAndProcess second resume.
+	descendantsSetSemaphore wait.
+	
+	self assert: (descendants allSatisfy: [:p | p isTerminated not]).
+	
+	example traceInformation tracingProcess: traceAndProcess second.
+	example ensureTerminatedProcess.
+
+	self assert: (descendants allSatisfy: [:p | p isTerminated]).
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/methodProperties.json b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/methodProperties.json
@@ -0,0 +1,9 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"setUp" : "pre 1/12/2023 09:09",
+		"tearDown" : "pre 1/12/2023 09:10",
+		"testKeepingTrackOfAllDescendingProcesses" : "pre 1/12/2023 09:00",
+		"testProbingAMethodCalledInANewProcess" : "pre 1/11/2023 16:18",
+		"testTerminatingAllDescendantProcesses" : "pre 1/12/2023 09:13" } }
diff --git a/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/properties.json b/packages/Babylonian-Tests.package/BPConcurrentTracingTest.class/properties.json
@@ -0,0 +1,14 @@
+{
+	"category" : "Babylonian-Tests",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		"preventTerminationSemaphore" ],
+	"name" : "BPConcurrentTracingTest",
+	"pools" : [
+		 ],
+	"super" : "TestCase",
+	"type" : "normal" }
diff --git a/packages/Babylonian-Tests.package/BPTracingTest.class/methodProperties.json b/packages/Babylonian-Tests.package/BPTracingTest.class/methodProperties.json
@@ -12,7 +12,6 @@
 		"testExampleWithProbesCountsTraceValuesCorrectly" : "lu 11/22/2021 22:03",
 		"testExampleWithProbesReturnsTraceValuesSortedChronologically" : "pre 1/11/2023 13:43",
 		"testFinishedTracesAreComplete" : "jb 12/7/2020 19:10",
-		"testProbingAMethodCalledInANewProcess" : "pre 1/11/2023 16:18",
 		"testProfilingTracingRecordsTimesToRun" : "pre 11/29/2022 16:42",
 		"testTheTracingReturnsTheExpressionValueAnyways" : "jb 12/7/2020 19:10",
 		"testTracingAnErrorRecordsTheStack" : "jb 12/7/2020 19:10",
