Add framework and tests for compilation/code creation inside a sandbox

Open issues:

* #testClassComment fails because accesses to the FilePlugin are not allowed - we could either create an exception for the sources file or process these requests outside of the sanfbox.
* #testSubclass crashes the VM because of something we are doing wrong/differently than normal Trunk during the behavior creation. See: http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217860.html

packages/SimulationStudio-Sandbox.package/ClassDescription.extension/class/dontLogCompiledSourcesDuring..st

@@ -0,0 +1,7 @@
+*SimulationStudio-Sandbox-compiling-pseudo override
+dontLogCompiledSourcesDuring: aBlock
+
+	| previous |
+	previous := self logCompiledSources.
+	self logCompiledSources: false.
+	^ aBlock ensure: [self logCompiledSources: previous]

packages/SimulationStudio-Sandbox.package/ClassDescription.extension/methodProperties.json

@@ -0,0 +1,5 @@
+{
+	"class" : {
+		"dontLogCompiledSourcesDuring:" : "ct 12/28/2021 22:54" },
+	"instance" : {
+		 } }

packages/SimulationStudio-Sandbox.package/ClassDescription.extension/properties.json

@@ -0,0 +1,2 @@
+{
+	"name" : "ClassDescription" }

packages/SimulationStudio-Sandbox.package/Sandbox.class/class/disableLoggingAndNotifyingDuringCompilation..st

@@ -0,0 +1,5 @@
+support
+disableLoggingAndNotifyingDuringCompilation: aBlock
+
+	^ SystemChangeNotifier uniqueInstance doSilently:
+		[ClassDescription dontLogCompiledSourcesDuring: aBlock]

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/basicEvaluate..st

@@ -1,8 +1,4 @@
 evaluating
 basicEvaluate: aBlock
-	"Evaluate aBlock in a the receiver, isolating it from the rest of the image, and answer the result as it is seen from the global perspective.
-	PRIVATE! Does not care about any exceptions that are signaled during the simulation, causing them to be handled still inside the sandbox, even if an exception handler has been defined outside of the sandbox stack. Depending on the configuration of the sandbox and your image, this can mean that even the eventual pop-up of the debugger will be simulated and thus invisible to you! Usually, it is a better idea to use the public #evaluate: protocol instead."
 
-	^ (SandboxContext newFrom: thisContext)
-		sandbox: self;
-		runSimulated: aBlock contextAtEachStep: []
+	^ self basicEvaluate: aBlock contextAtEachStep: []

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/basicEvaluate.contextAtEachStep..st

@@ -0,0 +1,8 @@
+evaluating
+basicEvaluate: aBlock contextAtEachStep: anotherBlock
+	"Evaluate aBlock in a the receiver, isolating it from the rest of the image. Evaluate anotherBlock with the current context prior to each instruction executed.  Answer the result as it is seen from the global perspective.
+	PRIVATE! Does not care about any exceptions that are signaled during the simulation, causing them to be handled still inside the sandbox, even if an exception handler has been defined outside of the sandbox stack. Depending on the configuration of the sandbox and your image, this can mean that even the eventual pop-up of the debugger will be simulated and thus invisible to you! Usually, it is a better idea to use the public #evaluate: protocol instead."
+
+	^ (SandboxContext newFrom: thisContext)
+		sandbox: self;
+		runSimulated: aBlock contextAtEachStep: anotherBlock

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/evaluate.contextAtEachStep.ifFailed..st

@@ -0,0 +1,13 @@
+evaluating
+evaluate: aBlock contextAtEachStep: contextBlock ifFailed: failBlock
+	"Evaluate aBlock in a the receiver and answer the result, isolating it from the rest of the image. Evaluate anotherBlock with the current context prior to each instruction executed. If aBlock signals a failure, evaluate failBlock with that failure.
+	
+	Example:
+		Sandbox evaluate: [1 / 0] ifFailed: [:ex | Transcript showln: ex description].
+	"
+
+	^ self
+		evaluate: aBlock
+		contextAtEachStep: contextBlock
+		on: Error, Warning, Halt
+		do: failBlock

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/evaluate.contextAtEachStep.on.do..st

@@ -0,0 +1,27 @@
+evaluating
+evaluate: aBlock contextAtEachStep: contextBlock on: exceptionHandler do: exceptionBlock
+	"Evaluate aBlock in the receiver, isolating it from the rest of the image. If aBlock signals an exception that can handled by the exceptionHandler, evaluate exceptionBlock with it. Evaluate contextBlock with the current context prior to each instruction executed. Answer the simulated value of aBlock.
+	NOTE: Unhandled errors raised by aBlock will bubble up along the sender stack, but still, all handling is simulated in the sandbox until the exception will have been resumed. Depending on the configuration of the sandbox and your image, this can mean that even the pop-up of the eventual debugger will be simulated and thus invisible to you! Thus make sure to pass all relevant exceptions with this message.
+	
+	Example:
+		Sandbox evaluate: [1 / 0] on: ZeroDivide do: [:ex | Transcript showln: ex description].
+		Sandbox new
+			evaluate: [2 / 3]
+			contextAtEachStep: [:ctx | Transcript showln: {ctx. ctx pc}]
+			on: ZeroDivide
+			do: [:ex | Transcript showln: ex description] .
+		
+		""Use with CAUTION and check your image via the ProcessBrowser afterwards""
+		Sandbox evaluate: [self halt] on: ZeroDivide do: [:ex | Transcript showln: ex description].
+	"
+
+	| result exception |
+	self
+		basicEvaluate: [[result := aBlock value]
+			on: exceptionHandler
+			do: [:ex | exception := ex]]
+		contextAtEachStep: contextBlock.
+
+	(self basicEvaluate: [exception]) ifNotNil: [:ex | ^ exceptionBlock cull: ex].
+
+	^ self readableObjectFor: (self basicEvaluate: [result])

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/evaluate.ifFailed..st

@@ -8,5 +8,5 @@ evaluate: aBlock ifFailed: failBlock
 
 	^ self
 		evaluate: aBlock
-		on: Error, Warning, Halt
-		do: failBlock
+		contextAtEachStep: []
+		ifFailed: failBlock

packages/SimulationStudio-Sandbox.package/Sandbox.class/instance/evaluate.on.do..st

@@ -9,11 +9,8 @@ evaluate: aBlock on: exceptionHandler do: exceptionBlock
 		Sandbox evaluate: [self halt] on: ZeroDivide do: [:ex | Transcript showln: ex description].
 	"
 
-	| result exception |
-	self basicEvaluate: [[result := aBlock value]
+	^ self
+		evaluate: aBlock
+		contextAtEachStep: []
 		on: exceptionHandler
-		do: [:ex | exception := ex]].
-
-	(self basicEvaluate: [exception]) ifNotNil: [:ex | ^ exceptionBlock cull: ex].
-
-	^ self readableObjectFor: (self basicEvaluate: [result])
+		do: exceptionBlock

packages/SimulationStudio-Sandbox.package/Sandbox.class/methodProperties.json

@@ -1,6 +1,7 @@
 {
 	"class" : {
 		"debug:" : "ct 3/5/2021 21:17",
+		"disableLoggingAndNotifyingDuringCompilation:" : "ct 12/28/2021 22:56",
 		"evaluate:" : "ct 3/6/2021 13:12",
 		"evaluate:ifFailed:" : "ct 3/6/2021 13:12",
 		"evaluate:on:do:" : "ct 3/6/2021 13:12",
@@ -9,13 +10,16 @@
 		"streamSelectorsFor:arguments:thatAnswer:" : "ct 11/13/2021 16:11" },
 	"instance" : {
 		"addObject:" : "ct 3/22/2021 17:51",
-		"basicEvaluate:" : "ct 11/13/2021 16:12",
+		"basicEvaluate:" : "ct 11/15/2021 23:05",
+		"basicEvaluate:contextAtEachStep:" : "ct 11/15/2021 23:05",
 		"debug:" : "ct 3/5/2021 21:25",
 		"elements:exchangeIdentityWith:" : "ct 1/10/2021 21:03",
 		"elements:forwardIdentityTo:copyHash:" : "ct 3/4/2021 20:19",
 		"evaluate:" : "ct 3/6/2021 13:10",
-		"evaluate:ifFailed:" : "ct 3/6/2021 13:10",
-		"evaluate:on:do:" : "ct 3/6/2021 12:45",
+		"evaluate:contextAtEachStep:ifFailed:" : "ct 11/15/2021 23:11",
+		"evaluate:contextAtEachStep:on:do:" : "ct 11/15/2021 23:10",
+		"evaluate:ifFailed:" : "ct 11/15/2021 23:12",
+		"evaluate:on:do:" : "ct 11/15/2021 23:11",
 		"exportMemory" : "ct 3/6/2021 01:38",
 		"hashFor:" : "ct 1/10/2021 21:40",
 		"importMemory:" : "ct 3/6/2021 01:39",

packages/SimulationStudio-Sandbox.package/Sandbox2.class/class/disableLoggingAndNotifyingDuringCompilation..st

@@ -0,0 +1,5 @@
+support
+disableLoggingAndNotifyingDuringCompilation: aBlock
+
+	^ SystemChangeNotifier uniqueInstance doSilently:
+		[ClassDescription dontLogCompiledSourcesDuring: aBlock]

packages/SimulationStudio-Sandbox.package/Sandbox2.class/methodProperties.json

@@ -2,6 +2,7 @@
 	"class" : {
 		"benchmarkSandboxVsSandbox2" : "ct 11/13/2021 17:25",
 		"debug:" : "ct 11/13/2021 16:11",
+		"disableLoggingAndNotifyingDuringCompilation:" : "ct 12/29/2021 02:00",
 		"evaluate:" : "ct 11/13/2021 16:12",
 		"evaluate:ifFailed:" : "ct 11/13/2021 16:12",
 		"evaluate:on:do:" : "ct 11/13/2021 16:12",

packages/SimulationStudio-Tests-Sandbox.package/SandboxTest.class/instance/someToken.st

@@ -0,0 +1,4 @@
+accessing
+someToken
+
+	^ UUID nilUUID

packages/SimulationStudio-Tests-Sandbox.package/SandboxTest.class/instance/testClassComment.st

@@ -0,0 +1,6 @@
+tests
+testClassComment
+
+	| comment |
+	comment := self sandboxClass evaluate: [Object comment].
+	self assert: (comment includesSubstring: 'root').

packages/SimulationStudio-Tests-Sandbox.package/SandboxTest.class/instance/testCompile.st

@@ -0,0 +1,14 @@
+tests
+testCompile
+
+	| result token |
+	self assert: UUID nilUUID equals: self someToken.
+
+	token := UUID new asString.
+	result := self sandboxClass disableLoggingAndNotifyingDuringCompilation:
+		[self sandboxClass evaluate: [
+			self class compile: 'someToken ^' , token printString.
+			self someToken]].
+
+	self assert: token equals: result.
+	self assert: UUID nilUUID equals: self someToken.

packages/SimulationStudio-Tests-Sandbox.package/SandboxTest.class/instance/testSubclass.st

@@ -0,0 +1,30 @@
+tests
+testSubclass
+
+	| name |
+	self fail: #forLater. "Currently, simulation of subclassing will crash the VM. See: http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217860.html"
+
+	name := #SandboxTestClass , UUID new asString asLegalSelector asCamelCase.
+
+	self shouldnt: (Smalltalk hasClassNamed: name).
+
+	self sandboxClass disableLoggingAndNotifyingDuringCompilation:
+		[self sandboxClass evaluate: [ | class instance |
+			class := Object
+				subclass: name asSymbol
+				instanceVariableNames: 'griffle plonk'
+				classVariableNames: ''
+				poolDictionaries: ''
+				category: 'SimulationStudio-Tests-UserObjects'.
+			instance := class new.
+
+			self
+				assert: (instance isKindOf: class);
+				assert: (instance class == class);
+				assert: (thisContext objectClass: instance) == class.
+
+			class compile: 'foo ^ ' , self selector printString.
+
+			self assert: self selector printString equals: instance foo]].
+
+	self deny: (Smalltalk hasClassNamed: name).

packages/SimulationStudio-Tests-Sandbox.package/SandboxTest.class/methodProperties.json

@@ -3,13 +3,17 @@
 		 },
 	"instance" : {
 		"sandboxClass" : "ct 11/13/2021 16:05",
+		"someToken" : "ct 12/28/2021 23:00",
 		"testBitBlt" : "ct 11/13/2021 00:00",
 		"testCannotUsurpExecution" : "ct 11/13/2021 00:01",
+		"testClassComment" : "ct 12/29/2021 01:57",
+		"testCompile" : "ct 12/28/2021 23:00",
 		"testFindSelectors" : "ct 12/27/2021 00:32",
 		"testIdentityHashConstant" : "ct 11/13/2021 00:01",
 		"testMemoryHashes" : "ct 11/13/2021 00:01",
 		"testMemoryObjects" : "ct 11/13/2021 00:01",
 		"testOperationForbidden" : "ct 11/13/2021 00:01",
 		"testRecursiveSandbox" : "ct 11/13/2021 00:01",
 		"testSandbox" : "ct 11/13/2021 00:01",
-		"testSandbox2" : "ct 11/14/2021 17:55" } }
+		"testSandbox2" : "ct 11/14/2021 17:55",
+		"testSubclass" : "ct 12/29/2021 19:15" } }