Failsafe tonel

MonticelloTonel-Core.package/TonelParser.class/instance/method.st

@@ -3,7 +3,7 @@ method
 	| type selector |
 
 	type := self untilIncluding: '>>'.
-	selector := self cleanSelector: (self untilExcluding: '[').
+	selector := self cleanSelector: (self selector).
 	type := type trimBoth substrings: ' '.
 	type size = 1 ifTrue: [ type := type copyWith: nil ].
 	^ {

MonticelloTonel-Core.package/TonelParser.class/instance/selector.st

@@ -0,0 +1,9 @@
+parsing
+selector
+
+	^ String streamContents: [ :out |
+		  [ stream atEnd or: [ stream peek isSeparator not ] ] whileFalse: [ stream next ].
+		  [ stream atEnd or: [ stream peek isSeparator ] ] whileFalse: [
+			  out nextPut: stream next ].
+		  [ stream atEnd or: [ '[!' includes: stream peek ] ] whileFalse: [
+			  out nextPut: stream next ] ]

MonticelloTonel-Core.package/TonelSourceScanner.class/instance/scan.st

@@ -1,6 +1,18 @@
 scanning
 scan
 	self prepareToScan.
+	stream peek = $! ifTrue: [
+		"Robust mode, source use a *chunk* format. existing ! are escaped (doubled)"
+		stream next.
+		^ (String streamContents: [ :str |
+			| ch |
+			[	ch := stream peek.
+				ch ~= $! or: [ 
+					stream next.
+					ch := stream peek.
+					ch = $! ] ]
+			whileTrue: [ str nextPut: stream next ] ] ) withInternalLineEndings ].
+
 	stream peek = $[ ifFalse: [ TonelParseError signal: 'Can''t parse method body' ].
 	[ stream atEnd or: [ isFinished ] ]
 	whileFalse: [ self scanNextChunk ].

MonticelloTonel-Core.package/TonelWriter.class/instance/writeMethodBody.on..st

@@ -0,0 +1,19 @@
+private - writing
+writeMethodBody: methodBody on: aStream
+
+	| nl reader |
+	nl := self newLine.
+
+	"Check is the current body is robust. The most correct approach is to try to read it back"
+	reader := ('[' , methodBody , ']') readStream.
+	[ (TonelSourceScanner on: reader) scan ] on: TonelParseError do: [ reader := nil ].
+	(reader isNotNil and: [ reader atEnd ]) ifFalse: [
+		"If parse failed, then use an alternative robust *chunk* format instead.
+		Body is strictly delimited by `!` and existing `!` in the content are doubled"
+		aStream << ' !'.
+		methodBody do: [ :each |
+			each = $! ifTrue: [ aStream << $! ].
+			aStream << each ].
+		aStream << '!' << nl.
+		^ self ].
+	aStream << ' [' << methodBody << nl << ']' << nl

MonticelloTonel-Core.package/TonelWriter.class/instance/writeMethodDefinition.parent.on..st

@@ -10,5 +10,5 @@ writeMethodDefinition: aMethodDefinition parent: aClassDefinition on: aStream
 			aStream
 				<< nl
 				<< (self methodDefinitionOf: aMethodDefinition) << nl
-				<< fullClassName << ' >> ' << methodDeclaration
-				<< ' [' << methodBody << nl << ']' << nl ]
+				<< fullClassName << ' >> ' << methodDeclaration.
+			self writeMethodBody: methodBody on: aStream ]

MonticelloTonel-Tests.package/TonelParserTest.class/instance/testMethodRobustBody.st

@@ -0,0 +1,18 @@
+tests
+testMethodRobustBody
+	self
+		assertParse: '!¿["''#(#{({!'
+		rule: #methodBody
+		equals: '¿["''#(#{({'.
+	self
+		assertParse: '!])}¿!'
+		rule: #methodBody
+		equals: '])}¿'.
+	self
+		assertParse: '!!!!'
+		rule: #methodBody
+		equals: '!'.
+	self
+		assertParse: '!!!a!!!!b!!!'
+		rule: #methodBody
+		equals: '!a!!b!'.

MonticelloTonel-Tests.package/TonelWriterTest.class/instance/testWriteRobustMethodDefinitionOn.st

@@ -0,0 +1,63 @@
+tests
+testWriteRobustMethodDefinitionOn
+
+	| writer def stream |
+	writer := self actualClass new.
+
+	"To much closer"
+	stream := String new writeStream.
+	def := MCMethodDefinition
+		       className: #Object
+		       classIsMeta: false
+		       selector: #selector
+		       category: 'accessing'
+		       timeStamp: nil
+		       source: 'selector ^ ] 42'.
+	writer writeMethodDefinition: def on: stream.
+	self
+		assert: stream contents lines last
+		equals: 'Object >> selector ! ^ ] 42!'.
+
+	"To much opener"
+	stream := String new writeStream.
+	def := MCMethodDefinition
+		       className: #Object
+		       classIsMeta: false
+		       selector: #selector
+		       category: 'accessing'
+		       timeStamp: nil
+		       source: 'selector ^ [ 42'.
+	writer writeMethodDefinition: def on: stream.
+	self
+		assert: stream contents lines last
+		equals: 'Object >> selector ! ^ [ 42!'.
+
+	"To much quotes"
+	stream := String new writeStream.
+	def := MCMethodDefinition
+		       className: #Object
+		       classIsMeta: false
+		       selector: #selector
+		       category: 'accessing'
+		       timeStamp: nil
+		       source: 'selector ^ " 42'.
+
+	writer writeMethodDefinition: def on: stream.
+	self
+		assert: stream contents lines last
+		equals: 'Object >> selector ! ^ " 42!'.
+
+	"To much everything"
+	stream := String new writeStream.
+	def := MCMethodDefinition
+		       className: #Object
+		       classIsMeta: false
+		       selector: #selector
+		       category: 'accessing'
+		       timeStamp: nil
+		       source: 'selector ^ " '' #[ [ #( { ! !! 42 " '' ] ) }'.
+
+	writer writeMethodDefinition: def on: stream.
+	self
+		assert: stream contents lines last
+		equals: 'Object >> selector ! ^ " '' #[ [ #( { !! !!!! 42 " '' ] ) }!'.