[BUG][TryItOut] Updating to 2.9alpha with alternate syntax enabled

Bob Arning arning at charm.net
Wed Jun 14 18:51:37 UTC 2000


On Wed, 14 Jun 2000 10:08:26 +0200 Henrik Gedenryd <Henrik.Gedenryd at lucs.lu.se> wrote:
>> From the stack trace, it would appear that "Preferences printAlternateSyntax"
>> was true. Could you have been testing the alternate syntax in that image
>> somewhere prior to filing in the new change sets?
>
>Forgive me if I'm wrong here, but now that two people have bumped in to
>this, wasn't the intention that the alternative syntax would not affect
>filing in and out code, as this would always be done using the oldie syntax?

Alternate syntax test pilots,

Here is a fix that will hopefully fix the problems experienced filing in code when alternate syntax was enabled. Try it out and see if it solvs your problems.

- This is for 2.9a ONLY 
- Turn OFF alternate syntax.
- If you have not already filed in change set 2406 (in the update stream), do so now.
- File in the attached code
- Turn ON alternate syntax.
- Try filing in other stuff.

Let me know of problems.

Cheers,
Bob

===== code follows =====
'From Squeak2.9alpha of 13 June 2000 [latest update: #2407] on 14 June 2000 at 2:39:21 pm'!
"Change Set:		altSynOverride
Date:			14 June 2000
Author:			Bob Arning

Fixes problems filing in code with while alternate syntax is enabled.

PRE-REQUISITE: 2.9a ONLY, change set 2406 REQUIRED

NOTE: This change set is manually reordered - be careful when hack around.
"!

Notification subclass: #RequestAlternateSyntaxSetting
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-Exceptions Kernel'!

!RequestAlternateSyntaxSetting methodsFor: 'as yet unclassified' stamp: 'RAA 6/14/2000 13:41'!
defaultAction

	self resume: Preferences printAlternateSyntax! !


!Compiler methodsFor: 'public access' stamp: 'RAA 6/14/2000 13:49'!
parse: textOrStream in: aClass notifying: req dialect: useDialect
	"Compile the argument, textOrStream, with respect to the class, aClass, 
	and answer the MethodNode that is the root of the resulting parse tree. 
	Notify the argument, req, if an error occurs. The failBlock is defaulted to 
	an empty block."

	self from: textOrStream class: aClass context: nil notifying: req.
	^ ((useDialect and: [RequestAlternateSyntaxSetting signal])
		ifTrue: [DialectParser]
		ifFalse: [Parser]) new
			parse: sourceStream
			class: class
			noPattern: false
			context: context
			notifying: requestor
			ifFail: []! !


!Parser methodsFor: 'public access' stamp: 'RAA 6/14/2000 14:34'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
	"Answer a MethodNode for the argument, sourceStream, that is the root of 
	a parse tree. Parsing is done with respect to the argument, class, to find 
	instance, class, and pool variables; and with respect to the argument, 
	ctxt, to find temporary variables. Errors in parsing are reported to the 
	argument, req, if not nil; otherwise aBlock is evaluated. The argument 
	noPattern is a Boolean that is true if the the sourceStream does not 
	contain a method header (i.e., for DoIts)."

	 | meth repeatNeeded myStream parser |
	(req notNil and: [RequestAlternateSyntaxSetting signal and: [(sourceStream isKindOf: FileStream) not]])
		ifTrue: [parser _ self as: DialectParser]
		ifFalse: [parser _ self].
	myStream _ sourceStream.
	[repeatNeeded _ false.
	parser init: myStream notifying: req failBlock: [^ aBlock value].
	doitFlag _ noPattern.
	failBlock_ aBlock.
	[meth _ parser method: noPattern context: ctxt
				encoder: (Encoder new init: class context: ctxt notifying: parser)] 
		on: ParserRemovedUnusedTemps 
		do: 
			[ :ex | repeatNeeded _ (requestor isKindOf: TextMorphEditor) not.
			myStream _ ReadStream on: requestor text string.
			ex resume].
	repeatNeeded] whileTrue.
	encoder _ failBlock _ requestor _ parseNode _ nil. "break cycles & mitigate refct overflow"
	^ meth! !

!Parser methodsFor: 'public access' stamp: 'RAA 6/14/2000 13:50'!
parseArgsAndTemps: aString notifying: req 
	"Parse the argument, aString, notifying req if an error occurs. Otherwise, 
	answer a two-element Array containing Arrays of strings (the argument 
	names and temporary variable names)."

	(req notNil and: [RequestAlternateSyntaxSetting signal]) ifTrue:
		[^ (self as: DialectParser) parseArgsAndTemps: aString notifying: req].
	aString == nil ifTrue: [^#()].
	doitFlag _ false.		"Don't really know if a doit or not!!"
	^self initPattern: aString
		notifying: req
		return: [:pattern | (pattern at: 2) , self temporaries]! !


!ReadWriteStream methodsFor: 'fileIn/Out' stamp: 'RAA 6/14/2000 13:48'!
fileInAnnouncing: announcement
	"This is special for reading expressions from text that has been formatted 
	with exclamation delimitors. The expressions are read and passed to the 
	Compiler. Answer the result of compilation.  Put up a progress report with
     the given announcement as the title."
	| val chunk |
	announcement 
		displayProgressAt: Sensor cursorPoint
		from: 0 
		to: self size
		during: [ :bar |
			[
				[self atEnd] whileFalse: [
					bar value: self position.
					self skipSeparators.
					val _ (self peekFor: $!!) ifTrue: [
						(Compiler evaluate: self nextChunk logged: false) scanFrom: self
					] ifFalse: [
						chunk _ self nextChunk.
						self checkForPreamble: chunk.
						Compiler evaluate: chunk logged: true
					].
					self skipStyleChunk
				].
				self close
			] 
				on: RequestAlternateSyntaxSetting
				do: [ :ex | ex resume: false]
		].
	^ val! !






More information about the Squeak-dev mailing list