Example Mining (#153)

* Adds packages

* Adds all classes and class docs

* Adds majority of (yet) failing tests

* Add basic accessing methods

* Add constant methods & extension methods

* Adds adding examples per BPDebugger

* Removes halt

* Moves BPDebugger additions as extension methods

* Adds ExamplesMorph and ExampleMorph UI

* Fixes cascade for specimen editing

* Adds BPSpecimenCopy

* Core Tools

* TestCaseExample & belonging Morph

* MorphicToolBuilder extension methods

* Adds logic contents of Minimization package

* Removes unused methods

* Adds example minimizing package to filtered fpr trace values

* Adds package to baseline

* Adjusts baseline

* tracked package to single examplemining package

* Update .squot

* Update .smalltalk.ston

* Update testSomething.st

* Update .squot

* Removes examplemining package

* Adds examplemining package in correct folder

* bugfix testcase search tool

now works for methods that lack a packagename

* specimen editing and minimizing have different icons

* bugfix: show specimen printstring, not always receiver printstring

* remove usage of external method

#asDictionary for Collection classes is part of a Pharo-compability package that squot requires, not of Babylonian

* forgot one usage of external method

* One more usage...

* set class directly in test

* merge dev

* Minimizing executes example synchronously

Otherwise we can't properly access the recording afterwards

---------

Co-authored-by: Eva Krebs <[email protected]>

.smalltalk.ston

@@ -10,7 +10,7 @@ SmalltalkCISpec {
   #testing : {
     #categories : [ 'Babylonian-*' ],
     #coverage : {
-      #categories : [ 'Babylonian-Core', 'Babylonian-UI', 'Babylonian-Compiler', 'Babylonian-ProbeLog' ]
+      #categories : [ 'Babylonian-Core', 'Babylonian-UI', 'Babylonian-Compiler', 'Babylonian-ProbeLog', 'Babylonian-ExampleMining' ]
     }
   }
 }

.squot

@@ -5,5 +5,6 @@ OrderedDictionary {
 	'packages/Babylonian-Tests.package' : #SquotCypressCodeSerializer,
 	'packages/Babylonian-UI.package' : #SquotCypressCodeSerializer,
 	'packages/BaselineOfBabylonianProgramming.package' : #SquotCypressCodeSerializer,
-	'packages/Babylonian-ProbeLog.package' : #SquotCypressCodeSerializer
+	'packages/Babylonian-ProbeLog.package' : #SquotCypressCodeSerializer,
+	'packages/Babylonian-ExampleMining.package' : #SquotCypressCodeSerializer
 }

packages/Babylonian-Core.package/BPExampleRecorder.class/instance/recordFrom..st

@@ -2,4 +2,4 @@ private-recording
 recordFrom: aContext
 
 	#(bpExampleRecording) withoutLayersDo: [
-		recordedCalls add: {aContext receiver . aContext arguments}]
+		recordedCalls add: {aContext receiver copy. aContext arguments copy}]

packages/Babylonian-Core.package/BPExampleRecorder.class/instance/recordedCalls.st

@@ -0,0 +1,4 @@
+accessing
+recordedCalls
+
+	^ recordedCalls

packages/Babylonian-Core.package/BPExampleRecorder.class/methodProperties.json

@@ -6,7 +6,8 @@
 		"installMyselfInProcess" : "pre 12/16/2020 16:21",
 		"instrumentMethod:" : "pre 12/16/2020 17:06",
 		"instrumentedSourceFor:" : "pre 12/16/2020 17:00",
-		"recordFrom:" : "pre 12/16/2020 17:03",
+		"recordFrom:" : "joabe 7/6/2023 18:33",
+		"recordedCalls" : "joabe 7/6/2023 18:31",
 		"removeRecordingLayer" : "pre 12/16/2020 16:35",
 		"startRecording" : "pre 12/16/2020 16:19",
 		"stopRecording" : "pre 12/16/2020 17:04",

packages/Babylonian-Core.package/BPMethodExample.class/instance/argumentScriptStringAt..st

@@ -4,5 +4,5 @@ argumentScriptStringAt: index
 	| value |
 	value := self argumentScripts at: index.
 	^ value isLiveSpecimenReference
-		ifTrue: [self receiverConstructor printString]
+		ifTrue: [value printString]
 		ifFalse: [value]

packages/Babylonian-Core.package/BPMethodExample.class/instance/asPragma.st

@@ -1,16 +1,16 @@
 serialization
 asPragma
 
-	"'exampleNamed:' 'active:'? 'setUp:'? 'tearDown:'? 'self:'? 'with'*"
+	"'exampleNamed:' 'setUp:'? 'tearDown:'? 'self:'? 'with'*"
 	^ '<exampleNamed: ''{1}''{2}{3}{4}{5}>' format: {
 		self exampleName.
 		self setUpScript ifNil: [''] ifNotNil: [:setUpScript | ' setUp: ' , setUpScript printString].
 		self tearDownScript ifNil: [''] ifNotNil: [:tearDownScript | ' tearDown: ' , tearDownScript printString].
 		self receiverConstructor ifNil: [''] ifNotNil: [:aReceiverConstructor | 
 			aReceiverConstructor isLiveSpecimenReference 
 				ifFalse: [' self: ' , aReceiverConstructor printString]
-				ifTrue: [' self: ' , {#specimen . aReceiverConstructor printString} printString]].
+				ifTrue: [' self: ' , {aReceiverConstructor keyword . aReceiverConstructor printString} printString]].
 		self argumentScripts ifEmpty: [''] ifNotEmpty: [(self argumentScripts collect: [:anArgumentScript | 
 			' with: ' , (anArgumentScript isLiveSpecimenReference 
 				ifFalse: [anArgumentScript printString]
-				ifTrue: [{#specimen . anArgumentScript printString} printString])]) join]}
+				ifTrue: [{anArgumentScript keyword . anArgumentScript printString} printString])]) join]}

packages/Babylonian-Core.package/BPMethodExample.class/methodProperties.json

@@ -3,10 +3,10 @@
 		"bpExamplePragmaPrefix" : "pre 1/21/2021 15:45" },
 	"instance" : {
 		"argumentNames" : "pre 8/25/2020 09:41",
-		"argumentScriptStringAt:" : "pre 1/10/2023 16:17",
+		"argumentScriptStringAt:" : "ek 7/24/2023 19:06",
 		"argumentScripts" : "pre 7/23/2019 12:20",
 		"argumentScripts:" : "pre 7/23/2019 09:23",
-		"asPragma" : "pre 1/10/2023 16:40",
+		"asPragma" : "joabe 7/10/2023 15:51",
 		"canBeUsedForDoIts" : "jb 12/3/2020 22:38",
 		"initialize" : "pre 9/30/2020 09:55",
 		"initializeFromMethod:" : "pre 6/7/2021 15:11",

packages/Babylonian-Core.package/BPSpecimenReference.class/class/newWithSpecimen..st

@@ -0,0 +1,6 @@
+initialize-release
+newWithSpecimen: aSpecimen
+
+	^ self new
+		specimen: aSpecimen;
+		yourself

packages/Babylonian-Core.package/BPSpecimenReference.class/instance/keyword.st

@@ -0,0 +1,4 @@
+constants
+keyword
+
+	^ #specimen

packages/Babylonian-Core.package/BPSpecimenReference.class/methodProperties.json

@@ -1,10 +1,11 @@
 {
 	"class" : {
-		 },
+		"newWithSpecimen:" : "joabe 7/9/2023 20:57" },
 	"instance" : {
 		"initialize" : "pre 1/10/2023 16:14",
 		"isEmptyOrNil" : "pre 1/10/2023 16:27",
 		"isLiveSpecimenReference" : "pre 1/10/2023 16:26",
+		"keyword" : "joabe 7/9/2023 20:24",
 		"printString" : "pre 1/10/2023 16:26",
 		"specimen" : "pre 1/10/2023 16:13",
 		"specimen:" : "pre 1/10/2023 16:19",

packages/Babylonian-ExampleMining.package/.filetree

@@ -0,0 +1,4 @@
+{
+	"noMethodMetaData" : true,
+	"separateMethodMetaAndSource" : false,
+	"useCypressPropertiesFile" : true }

packages/Babylonian-ExampleMining.package/.squot-contents

@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ '31a714b5b534fd4988afa4e5447e0082' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotCypressCodeSerializer
+}

packages/Babylonian-ExampleMining.package/ArrayedCollection.extension/instance/bpMiniTemplateClass.st

@@ -0,0 +1,4 @@
+*Babylonian-ExampleMining-Minimization
+bpMiniTemplateClass
+
+	^ BPMiniArrayTemplate

packages/Babylonian-ExampleMining.package/ArrayedCollection.extension/methodProperties.json

@@ -0,0 +1,5 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"bpMiniTemplateClass" : "joabe 7/6/2023 17:57" } }

packages/Babylonian-ExampleMining.package/ArrayedCollection.extension/properties.json

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

packages/Babylonian-ExampleMining.package/Association.extension/instance/bpMiniTemplateClass.st

@@ -0,0 +1,4 @@
+*Babylonian-ExampleMining-Minimization
+bpMiniTemplateClass
+
+	^ BPMiniAssociationTemplate

packages/Babylonian-ExampleMining.package/Association.extension/methodProperties.json

@@ -0,0 +1,5 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"bpMiniTemplateClass" : "joabe 7/6/2023 17:58" } }

packages/Babylonian-ExampleMining.package/Association.extension/properties.json

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

packages/Babylonian-ExampleMining.package/BPDebugger.extension/instance/addExample.st

@@ -0,0 +1,17 @@
+*Babylonian-ExampleMining-Core
+addExample
+
+	| argumentSpecimen receiverSpecimen method |
+	receiverSpecimen := BPSpecimenReference new
+		specimen: self receiverInspector object;
+		yourself.
+	argumentSpecimen := self contextVariablesInspector object arguments
+		collect: [:argumentObject | BPSpecimenReference new
+			specimen: argumentObject;
+			yourself].
+	method := self selectedContext method.
+
+	(method bpNewExampleFrom: BPMethodExample)
+		receiverConstructor: receiverSpecimen;
+		argumentScripts: argumentSpecimen;
+		yourself.

packages/Babylonian-ExampleMining.package/BPDebugger.extension/instance/customButtonSpecs.st

@@ -0,0 +1,28 @@
+*Babylonian-ExampleMining-Core
+customButtonSpecs
+	"Answer an array of elements of the form wording, selector, help-message, that characterize the custom button row of a debugger."
+
+	| list |
+	list := #(('Proceed'	proceed				'Close the debugger and proceed.'	interruptedProcessShouldResume)
+		('Restart'		restart				'Reset this context to its start.')
+		('Into'			stepInto				'step Into message sends'	interruptedProcessIsReady)
+		('Over'			stepOver				'step Over message sends'	interruptedProcessIsReady)
+		('Through'		stepThrough		'step into a block'			interruptedProcessIsReady)
+		('Full Stack'		showFullStack			'show full stack')
+		('Where'		showWhere				'select current pc range')
+		('Tally It'			tally				'evaluate current selection and measure the time')
+		('Add Example' addExample 'Add current receiver and parameters as a Babylonian Example')).
+	(Preferences restartAlsoProceeds and: [self interruptedProcessShouldResume]) ifTrue:
+		[list := list collect: [:each |
+			each second == #restart
+				ifTrue: [each copy
+						at: 1 put: 'Proceed Here';
+						at: 3 put: 'Proceed from the beginning of this context.';
+						yourself]
+				ifFalse: [each second == #proceed
+					ifTrue: [each copy
+							at: 1 put: 'Proceed Top';
+							at: 3 put: 'Proceed from the current top context.';
+							yourself]
+					ifFalse: [each]]]].
+	^ list

packages/Babylonian-ExampleMining.package/BPDebugger.extension/methodProperties.json

@@ -0,0 +1,6 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"addExample" : "joabe 7/6/2023 22:22",
+		"customButtonSpecs" : "joabe 7/6/2023 19:42" } }

packages/Babylonian-ExampleMining.package/BPDebugger.extension/properties.json

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

packages/Babylonian-ExampleMining.package/BPDebuggerAddExampleTest.class/class/compilerClass.st

@@ -0,0 +1,4 @@
+compiling
+compilerClass
+
+	^ BPCompiler

packages/Babylonian-ExampleMining.package/BPDebuggerAddExampleTest.class/instance/testAddExampleButtonExists.st

@@ -0,0 +1,22 @@
+tests
+testAddExampleButtonExists
+
+	| process debugger addExampleButtonMaybe |
+	process := [ BPExampleMiningTestClass new doSomething ] newProcess.
+	debugger := BPDebugger
+		openOn: process
+		context: process suspendedContext
+		label: 'Test'
+		contents: nil
+		fullView: true.
+
+	addExampleButtonMaybe := debugger dependents select: [:morph | 
+		(morph isKindOf: PluggableButtonMorphPlus) 
+		and: [morph label asSymbol = 'Add Example' asSymbol]].
+
+	self assert: addExampleButtonMaybe isEmpty not.
+
+	debugger ifNotNil: [debugger close].
+	process ifNotNil: [process terminate].
+	process := nil.
+	debugger := nil.

packages/Babylonian-ExampleMining.package/BPDebuggerAddExampleTest.class/instance/testMethodExists.st

@@ -0,0 +1,4 @@
+tests
+testMethodExists
+
+	BPDebugger selectors includes: #addExample.

packages/Babylonian-ExampleMining.package/BPDebuggerAddExampleTest.class/methodProperties.json

@@ -0,0 +1,6 @@
+{
+	"class" : {
+		"compilerClass" : "joabe 7/4/2023 17:15" },
+	"instance" : {
+		"testAddExampleButtonExists" : "joabe 7/5/2023 16:01",
+		"testMethodExists" : "joabe 7/5/2023 16:02" } }

packages/Babylonian-ExampleMining.package/BPDebuggerAddExampleTest.class/properties.json

@@ -0,0 +1,15 @@
+{
+	"category" : "Babylonian-ExampleMining-Tests",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		"debugger",
+		"process" ],
+	"name" : "BPDebuggerAddExampleTest",
+	"pools" : [
+		 ],
+	"super" : "TestCase",
+	"type" : "normal" }

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/README.md

@@ -0,0 +1 @@
+I am an Explorer in a Morph. My exploree can be changed.

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/exploree..st

@@ -0,0 +1,5 @@
+accessing
+exploree: anObject
+
+	exploree := anObject.
+	self updateExplorer

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/exploree.st

@@ -0,0 +1,4 @@
+accessing
+exploree
+
+	^ exploree

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/getExploreeSelector..st

@@ -0,0 +1,5 @@
+accessing
+getExploreeSelector: aSymbol
+
+	getExploreeSelector := aSymbol.
+	self updateExploree

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/getExploreeSelector.st

@@ -0,0 +1,4 @@
+accessing
+getExploreeSelector
+
+	^ getExploreeSelector

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/initialize.st

@@ -0,0 +1,9 @@
+initialization
+initialize
+
+	super initialize.
+
+	self
+		color: Color transparent;
+		layoutPolicy: TableLayout new;
+		updateExplorer

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/model..st

@@ -0,0 +1,6 @@
+accessing
+model: aModel
+
+	model ifNotNil: [model removeDependent: self].
+	aModel ifNotNil: [aModel addDependent: self].
+	model := aModel

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/model.st

@@ -0,0 +1,4 @@
+accessing
+model
+
+	^ model

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/update..st

@@ -0,0 +1,4 @@
+updating
+update: aSymbol
+
+	aSymbol == getExploreeSelector ifTrue: [self updateExploree]

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/updateExploree.st

@@ -0,0 +1,4 @@
+updating
+updateExploree
+
+	self exploree: (self model perform: self getExploreeSelector)

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/instance/updateExplorer.st

@@ -0,0 +1,13 @@
+ui
+updateExplorer
+
+	| explorer |
+	self removeAllMorphs.
+
+	explorer := ((ToolBuilder build: (ObjectExplorer explore: self exploree))
+		findA: PluggableTreeMorph).
+	explorer
+		position: self position;
+		hResizing: #spaceFill;
+		vResizing: #spaceFill.
+	self addMorph: explorer

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/methodProperties.json

@@ -0,0 +1,14 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"exploree" : "joabe 7/5/2023 17:35",
+		"exploree:" : "joabe 7/5/2023 17:35",
+		"getExploreeSelector" : "joabe 7/5/2023 17:36",
+		"getExploreeSelector:" : "joabe 7/5/2023 17:35",
+		"initialize" : "joabe 7/5/2023 17:58",
+		"model" : "joabe 7/5/2023 17:52",
+		"model:" : "joabe 7/5/2023 17:58",
+		"update:" : "joabe 7/5/2023 17:59",
+		"updateExploree" : "joabe 7/5/2023 17:59",
+		"updateExplorer" : "joabe 7/9/2023 20:49" } }

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerMorph.class/properties.json

@@ -0,0 +1,16 @@
+{
+	"category" : "Babylonian-ExampleMining-Core",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "joabe 7/4/2023 17:40",
+	"instvars" : [
+		"exploree",
+		"getExploreeSelector",
+		"model" ],
+	"name" : "BPExampleMiningExplorerMorph",
+	"pools" : [
+		 ],
+	"super" : "Morph",
+	"type" : "normal" }

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerSpec.class/README.md

@@ -0,0 +1 @@
+I am the spec of the BPExampleRecordingToolExplorerMorph.

packages/Babylonian-ExampleMining.package/BPExampleMiningExplorerSpec.class/instance/buildWith..st

@@ -0,0 +1,4 @@
+building
+buildWith: aBuilder
+
+	^ aBuilder buildBPExplorer: self