Merge pull request #92 from hpi-swa-lab/big/fix-auto-refactor-styling

Fixes Auto Refactoring for the BPBrowser

packages/Babylonian-Compiler.package/BPCompiler.class/instance/compile.ifFail..st

@@ -1,20 +1,33 @@
 public access
-compile: aCueWithBPSource ifFail: failBlock
+compile: aCueWithStyledSource ifFail: failBlock
 
-	"This method expects source code which has annotations embedded in comments, if any."
-	| originalMethodNode bpSource basicCue |
-	bpSource := aCueWithBPSource sourceStream contents asString.
-	basicCue := CompilationCue
-		source: bpSource readStream
-		context: aCueWithBPSource context 
-		receiver: aCueWithBPSource receiver 
-		class: aCueWithBPSource getClass 
-		environment: aCueWithBPSource environment 
-		requestor: aCueWithBPSource requestor.
-	originalMethodNode := super compile: basicCue ifFail: failBlock.
+	"This method expects source code which has annotations embedded in comments, 
+	if any, meaning it's styled with text attributes. Since the BPBrowser breaks the premise 
+	of the Parser that the source stream and the code panel's morph code is the same, auto
+	refactoring will quickly cause inconsistencies. For example, if one were to add a temporal 
+	variable to existing ones, with the second vertical line being at position 18, the styled 
+	version could have it at position 19. The parser would then re-add two lines,
+	causing for synctactic errors when compiling. Therefore, we remove the text styling
+	inside the morph to re-fullfill that premise again during compilation."
+	| originalMethodNode bpUnstyledSource unstyledCue |
+	bpUnstyledSource := aCueWithStyledSource sourceStream contents asString asBPSource.
+	aCueWithStyledSource requestor ifNotNil: [
+		aCueWithStyledSource requestor useDefaultStyler.
+		aCueWithStyledSource requestor setText: bpUnstyledSource.
+		aCueWithStyledSource requestor styler: (BPStyler new view: aCueWithStyledSource requestor).
+		].
 
-	bpSource := originalMethodNode sourceText asString.
-	(self methodSourceRequiresBPLayers: bpSource) ifTrue: [
-		(self compileInstrumentedVersionOf: aCueWithBPSource) ifFalse: failBlock].
-
-	^ originalMethodNode
+	unstyledCue := CompilationCue
+		source: bpUnstyledSource readStream
+		context: aCueWithStyledSource context
+		receiver: aCueWithStyledSource receiver 
+		class: aCueWithStyledSource getClass 
+		environment: aCueWithStyledSource environment 
+		requestor: aCueWithStyledSource requestor.
+	originalMethodNode := super compile: unstyledCue ifFail: failBlock.
+
+	bpUnstyledSource := originalMethodNode sourceText asString.
+	(self methodSourceRequiresBPLayers: bpUnstyledSource) ifTrue: [
+		(self compileInstrumentedVersionOf: aCueWithStyledSource) ifFalse: failBlock].	
+
+	 ^ originalMethodNode

packages/Babylonian-Compiler.package/BPCompiler.class/methodProperties.json

@@ -6,8 +6,8 @@
 	"instance" : {
 		"annotationKeywords" : "pre 11/8/2019 20:29",
 		"backgroundCompileInstrumentedVersionOf:basedOn:" : "pre 10/12/2020 15:36",
-		"compile:ifFail:" : "pre 5/3/2021 10:59",
-		"compileInstrumentedVersionOf:" : "pre 1/11/2021 15:51",
+		"compile:ifFail:" : "jb 10/17/2021 19:02",
+		"compileInstrumentedVersionOf:" : "jb 9/9/2021 17:31",
 		"keywords" : "pre 7/26/2019 14:00",
 		"methodSourceRequiresBPLayers:" : "pre 11/11/2019 15:49",
 		"parse:" : "pre 1/11/2021 15:51",

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/class/compilerClass.st

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

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertCanceled.st

@@ -0,0 +1,6 @@
+assertions
+assertCanceled
+
+	self
+		assertText: originalText;
+		assertSelection: previousSelection.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertSelection..st

@@ -0,0 +1,10 @@
+assertions
+assertSelection: selectionMatch
+
+	selectionMatch isBlock ifTrue: [
+		^ self assertSelection: selectionMatch value].
+	^ self
+		assert: selectionMatch
+		equals: (selectionMatch isInterval
+			ifTrue: [self selectionInterval]
+			ifFalse: [self selection])

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertSucceeded..st

@@ -0,0 +1,6 @@
+assertions
+assertSucceeded: textMatch
+
+	self
+		assertText: textMatch;
+		assertSelection: originalSelection.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertSucceeded.st

@@ -0,0 +1,4 @@
+assertions
+assertSucceeded
+
+	^ self assertSucceeded: originalText

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/assertText..st

@@ -0,0 +1,10 @@
+assertions
+assertText: textMatch
+
+	text isBlock ifTrue: [
+		^ self assertText: text value].
+	^ (textMatch respondsTo: #matches:)
+		ifTrue: [
+			self assert: [textMatch matches: (self codePaneTextMorph textMorph contents) asString]]
+		ifFalse: [
+			self assert: textMatch equals: (self codePaneTextMorph textMorph contents) asString]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/codePaneTextMorph.st

@@ -0,0 +1,4 @@
+private
+codePaneTextMorph
+
+	^ browser containingWindow submorphNamed: 'codePaneTextMorph'.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compile..st

@@ -0,0 +1,14 @@
+private
+compile: sourceString
+
+	| result |
+	originalText := text := sourceString.
+	previousSelection := originalSelection := 1 to: text size + 1.
+	selectionInterval := nil.
+	result := self class
+		compile: text
+		classified: 'generated'
+		notifying: self codePaneTextMorph.
+	result ifNil: [^ self].
+	self codePaneTextMorph accept.
+	selectionInterval := originalSelection.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compileMethodHeaderAndSetBrowserToIt.st

@@ -0,0 +1,6 @@
+private
+compileMethodHeaderAndSetBrowserToIt
+
+	text := 'someMethod\\	' withCRs asText.
+	self compile: text.
+	browser setSelector: #someMethod.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/compiling.shouldRaise.andSelect.testing..st

@@ -0,0 +1,20 @@
+private
+compiling: sourceCode shouldRaise: exceptionClass andSelect: selectionMatch testing: tests
+
+	"Test behavior of the compiler for the given sourceCode and expected an exception of kind exceptionClass. Other arguments:
+		* selectionMatch is used to check the selection of the source text that is active when an exception has occured. Can be a text, an interval, or a predicate block. See #assertSelection:.
+		* tests is an array of associations representing pairs of reactions (key) to the exception and the assertion (value) that should be run afterward.
+			* The key can be a boolean for answering yes/no dialogs, a string for selecting a named option from a dialog window, or a one-arg block to handle the occuring exception in a different way (see #handlerBlockFor:).
+			* The value can be either a string that will be compared to the final compiler source code or a custom assertion block that will be evaluated after the compilation has terminated (see #testBlockFor:)."
+
+	| referenceTest |
+	referenceTest := [] -> [].
+	(tests copyWithFirst: referenceTest) associationsDo: [:test |
+		self
+			should: [self compile: sourceCode.]
+			raise: exceptionClass
+			thenDo: [:exception |
+				previousSelection := self selectionInterval.
+				(self handlerBlockFor: test key) cull: exception].
+		self codePaneTextMorph accept.
+		(self testBlockFor: test value) value].

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/correctFrom.to.with..st

@@ -0,0 +1,10 @@
+emulating
+correctFrom: start to: stop with: aString
+
+	| delta userSelection |
+	userSelection := self selectionInterval.
+	text := (text first: start - 1) , aString , (text allButFirst: stop).
+	delta := aString size - (stop - start + 1).
+	self
+		selectInvisiblyFrom: userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ])
+		to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]).

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/generateUnknownSelector.st

@@ -0,0 +1,8 @@
+private
+generateUnknownSelector
+
+	| selector num |
+	selector := 'yourself'.
+	num := 0.
+	[(Symbol lookup: selector, num) notNil] whileTrue: [num := num + 1].
+	^ selector, num

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/handlerBlockFor..st

@@ -0,0 +1,6 @@
+private
+handlerBlockFor: message
+
+	^ message isBlock
+		ifTrue: [message]
+		ifFalse: [[:ex | [ex pass] valueSupplyingAnswer: message]]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/nextTokenFrom.direction..st

@@ -0,0 +1,10 @@
+emulating
+nextTokenFrom: start direction: dir
+
+	"simple token-finder for compiler automated corrections"
+	| loc str |
+	loc := start + dir.
+	str := self text.
+	[(loc between: 1 and: str size) and: [(str at: loc) isSeparator]]
+		whileTrue: [loc := loc + dir].
+	^ loc

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/removeGeneratedMethods.st

@@ -0,0 +1,4 @@
+private
+removeGeneratedMethods
+
+	self class removeCategory: 'generated'

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/runCase.st

@@ -0,0 +1,7 @@
+running
+runCase
+
+	^ Preferences 
+		setPreference: #confirmFirstUseOfStyle
+		toValue: false
+		during: [super runCase]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/selectFrom.to..st

@@ -0,0 +1,4 @@
+emulating
+selectFrom: start to: end
+
+	selectionInterval := start to: end.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/selectIntervalInvisibly..st

@@ -0,0 +1,4 @@
+emulating
+selectIntervalInvisibly: anInterval
+
+	selectionInterval := anInterval

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/selectInvisiblyFrom.to..st

@@ -0,0 +1,5 @@
+emulating
+selectInvisiblyFrom: start to: end
+
+	^ self
+		selectFrom: start to: end

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/selection.st

@@ -0,0 +1,4 @@
+private
+selection
+
+	^ text copyFrom: self selectionInterval start to: self selectionInterval stop

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/selectionInterval.st

@@ -0,0 +1,4 @@
+emulating
+selectionInterval
+
+	^ selectionInterval ifNil: [1 to: self text size]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/setUp.st

@@ -0,0 +1,5 @@
+running
+setUp
+
+	browser := BPBrowser fullOnClass: self class.
+	self compileMethodHeaderAndSetBrowserToIt.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/should.raise.thenDo..st

@@ -0,0 +1,12 @@
+assertions
+should: aBlock raise: anExceptionalEvent thenDo: aHandlerBlock
+
+	| raised result |
+	raised := false.
+	result := aBlock
+		on: anExceptionalEvent
+		do: [:ex |
+			raised := true.
+			aHandlerBlock cull: ex].
+	self assert: raised description: ('aBlock should have raised {1}' translated format: {anExceptionalEvent}).
+	^ result

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/tearDown.st

@@ -0,0 +1,6 @@
+running
+tearDown
+
+	self codePaneTextMorph accept.
+	super tearDown.
+	browser containingWindow abandon.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testAmbiguousSelector.st

@@ -0,0 +1,14 @@
+tests
+testAmbiguousSelector
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: '\^1@-1' withCRs.
+	text append:  '\^1@-1' withCRs.	
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\^1@ -1') withCRs.
+	self 
+		compiling: text
+		shouldRaise: AmbiguousSelector
+		andSelect: '@-'
+		testing: {
+			[:ex | ex resume] -> [self assertCanceled].
+			[:ex | ex resume: '@ -'] -> expectedString }.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testBlockFor..st

@@ -0,0 +1,6 @@
+private
+testBlockFor: test
+
+	^ test isBlock
+		ifTrue: [test]
+		ifFalse: [[self assertSucceeded: test]]

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesBlockLocalTemp.st

@@ -0,0 +1,14 @@
+tests
+testPastesBlockLocalTemp
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	text append:  ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	expectedString := ('someMethod\', Character startOfHeader, '\	\^ [ | foo | ', self undeclaredVar, ' ] value') withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare block-local temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesFirstTempAtMethodLevel.st

@@ -0,0 +1,14 @@
+tests
+testPastesFirstTempAtMethodLevel
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: self undeclaredVar.
+	text append: self undeclaredVar.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\| foo |', self undeclaredVar) withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesSecondTempAtMethodLevel.st

@@ -0,0 +1,14 @@
+tests
+testPastesSecondTempAtMethodLevel
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('| a | \ a := 3.', self undeclaredVar) withCRs.
+	text append:  ('| a | \ a := 3.', self undeclaredVar) withCRs.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	| a foo | \ a := 3.', self undeclaredVar) withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testPastesTempForBlockValue.st

@@ -0,0 +1,14 @@
+tests
+testPastesTempForBlockValue
+
+	| expectedString |
+	self codePaneTextMorph textMorph contents append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	text append: ('\^ [ ', self undeclaredVar ,' ] value') withCRs.
+	expectedString :=  ('someMethod\', Character startOfHeader, '\	\| foo |\^ [ ', self undeclaredVar, ' ] value') withCRs.
+	self 
+		compiling: text
+		shouldRaise: UndeclaredVariable
+		andSelect: 'foo'
+		testing: {
+			false -> [self assertCanceled].
+			'declare method temp' -> expectedString}.

packages/Babylonian-Tests.package/BPCompilerExceptionTest.class/instance/testUndefinedVariable.st

@@ -0,0 +1,13 @@
+tests
+testUndefinedVariable
+
+
+	self codePaneTextMorph textMorph contents append: '| foo | ^ foo'.
+	text append: '| foo | ^ foo'.
+	self 
+		compiling: text
+		shouldRaise: UndefinedVariable
+		andSelect: [(self text allRangesOfRegexMatches: '(?<=\^ )foo') first]
+		testing: {
+			true -> [self assertSucceeded].
+			false -> [self assertCanceled] }.