# HG changeset patch # User Claus Gittinger # Date 1394057566 -3600 # Node ID 1f8f2e6335870349c1638b4f19316e62783733f4 # Parent b9c13d91d6fe9c5c3e26bc231195bda620629cb2 class: Parser changed: #literalInlineObjectFor: #parsePragma #primary_identifier use asMutator instead of (a,':') asSymbol diff -r b9c13d91d6fe -r 1f8f2e633587 Parser.st --- a/Parser.st Wed Mar 05 22:35:57 2014 +0100 +++ b/Parser.st Wed Mar 05 23:12:46 2014 +0100 @@ -7039,19 +7039,19 @@ class instSize: names size. names keysAndValuesDo:[:idx :instVarName | - idx <= InlineObjectPrototype instSize ifTrue:[ - class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol). - inlineObjectsAreReadonly ifFalse:[ - class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol). - ]. - ] ifFalse:[ - Class withoutUpdatingChangesDo:[ - Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class. - inlineObjectsAreReadonly ifFalse:[ - Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class. - ]. - ]. - ]. + idx <= InlineObjectPrototype instSize ifTrue:[ + class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol). + inlineObjectsAreReadonly ifFalse:[ + class basicAddSelector:(instVarName asMutator) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol). + ]. + ] ifFalse:[ + Class withoutUpdatingChangesDo:[ + Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class. + inlineObjectsAreReadonly ifFalse:[ + Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class. + ]. + ]. + ]. ]. instance := class new. @@ -7493,58 +7493,58 @@ and:[ currentBlock isNil and:[ requestor notNil and:[ (autoHow := requestor perform:#autoDefineVariables ifNotUnderstood:nil) notNil]]]) ifTrue:[ - var := self variableOrError:varName. - self nextToken. - (var == #Error) ifTrue:[ - ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[ - autoHow == #workspace ifTrue:[ - holder := Workspace addWorkspaceVariable:varName. - var := VariableNode type:#WorkspaceVariable holder:holder name:varName. - ] ifFalse:[ - holder := self addDoItTemporary:varName. - var := VariableNode type:#DoItTemporary holder:holder name:varName. - ]. - ] ifFalse:[ - var := self correctVariable:varName atPosition:pos1 to:pos2. - ]. - var startPosition: pos1 endPosition: pos2. - ] + var := self variableOrError:varName. + self nextToken. + (var == #Error) ifTrue:[ + ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[ + autoHow == #workspace ifTrue:[ + holder := Workspace addWorkspaceVariable:varName. + var := VariableNode type:#WorkspaceVariable holder:holder name:varName. + ] ifFalse:[ + holder := self addDoItTemporary:varName. + var := VariableNode type:#DoItTemporary holder:holder name:varName. + ]. + ] ifFalse:[ + var := self correctVariable:varName atPosition:pos1 to:pos2. + ]. + var startPosition: pos1 endPosition: pos2. + ] ] ifFalse:[ - var := self variable. - self nextToken. + var := self variable. + self nextToken. ]. "/ errorFlag == true ifTrue:[self halt]. (var == #Error) ifTrue:[ - errorFlag := true + errorFlag := true ]. (tokenType == #'::') ifTrue:[ - globlName := rawName := varName. - - "is it in a namespace ?" - nameSpace := self findNameSpaceWith:globlName. - nameSpace notNil ifTrue:[ - globlName := nameSpace name , '::' , globlName - ]. - - [tokenType == #'::'] whileTrue:[ - nameSpace := globlName. - - self nextToken. - (tokenType == #Identifier) ifTrue:[ - self warnSTXNameSpaceUseAt:pos1. - varName := tokenName. - - globlName := (nameSpace , '::' , varName). - rawName := (rawName , '::' , varName). - - nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil. - nameSpaceGlobal isNil ifTrue:[ - warnedUnknownNamespaces isNil ifTrue:[ - warnedUnknownNamespaces := Set new. - ]. - (warnedUnknownNamespaces includes:nameSpace) ifFalse:[ + globlName := rawName := varName. + + "is it in a namespace ?" + nameSpace := self findNameSpaceWith:globlName. + nameSpace notNil ifTrue:[ + globlName := nameSpace name , '::' , globlName + ]. + + [tokenType == #'::'] whileTrue:[ + nameSpace := globlName. + + self nextToken. + (tokenType == #Identifier) ifTrue:[ + self warnSTXNameSpaceUseAt:pos1. + varName := tokenName. + + globlName := (nameSpace , '::' , varName). + rawName := (rawName , '::' , varName). + + nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil. + nameSpaceGlobal isNil ifTrue:[ + warnedUnknownNamespaces isNil ifTrue:[ + warnedUnknownNamespaces := Set new. + ]. + (warnedUnknownNamespaces includes:nameSpace) ifFalse:[ "/ not needed; already warned. "/ "correctIt :=" requestor "/ correctableError:('Unknown nameSpace: "', nameSpace,'"') @@ -7553,231 +7553,231 @@ "/ self warning:('unknown nameSpace: ', nameSpace) "/ position:pos1 to:tokenPosition-1. "/ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1. - warnedUnknownNamespaces add:nameSpace. - ] - ] ifFalse:[ - nameSpaceGlobal isNameSpace ifTrue:[ - "/ for now: only Smalltalk is allowed - nameSpaceGlobal ~~ Smalltalk ifTrue:[ + warnedUnknownNamespaces add:nameSpace. + ] + ] ifFalse:[ + nameSpaceGlobal isNameSpace ifTrue:[ + "/ for now: only Smalltalk is allowed + nameSpaceGlobal ~~ Smalltalk ifTrue:[ "/ self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1. - ] ifFalse:[ - globlName := varName - ]. - ] ifFalse:[ - nameSpaceGlobal isBehavior ifFalse:[ - self parseError:('invalid nameSpace: ' , nameSpace) position:pos1 to:tokenPosition-1. - ] ifTrue:[ - nameSpaceGlobal isLoaded ifTrue:[ - (nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[ - (Smalltalk at:rawName asSymbol) notNil ifTrue:[ - self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.') - position:pos1 to:source position "tokenPosition-1". - globlName := rawName asSymbol. - ] ifFalse:[ - self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace) - position:pos1 to:source position "tokenPosition-1". + ] ifFalse:[ + globlName := varName + ]. + ] ifFalse:[ + nameSpaceGlobal isBehavior ifFalse:[ + self parseError:('invalid nameSpace: ' , nameSpace) position:pos1 to:tokenPosition-1. + ] ifTrue:[ + nameSpaceGlobal isLoaded ifTrue:[ + (nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[ + (Smalltalk at:rawName asSymbol) notNil ifTrue:[ + self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.') + position:pos1 to:source position "tokenPosition-1". + globlName := rawName asSymbol. + ] ifFalse:[ + self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace) + position:pos1 to:source position "tokenPosition-1". "/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1. - ] - ] ifFalse:[ - "/ reference to a private class - (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[ - self classToCompileFor notNil ifTrue:[ - self isDoIt ifFalse:[ - parserFlags warnAboutReferenceToPrivateClass ifTrue:[ - self warning:('Referring to private class ''' , varName allBold , ''' here.') - doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false. - parserFlags warnAboutReferenceToPrivateClass:false. ] - position:pos1 to:source position " tokenPosition-1". - ]. - Tools::ToDoListBrowser notNil ifTrue:[ - self - notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1 - className:(self classToCompileFor name) selector:selector - severity:#warning priority:#medium - equalityParameter:nil - checkAction:nil. - ]. - ]. - ]. - ] - ]. - ] - ] - ]. - ]. - pos2 := source position. - self nextToken. - ]. - var := VariableNode globalNamed:globlName. - var startPosition: pos1 endPosition: pos2. - parseForCode ifFalse:[self rememberGlobalUsed:globlName]. - ]. - self markVariable:var from:pos1 to:pos1 + rawName size - 1 assigned:false. + ] + ] ifFalse:[ + "/ reference to a private class + (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[ + self classToCompileFor notNil ifTrue:[ + self isDoIt ifFalse:[ + parserFlags warnAboutReferenceToPrivateClass ifTrue:[ + self warning:('Referring to private class ''' , varName allBold , ''' here.') + doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false. + parserFlags warnAboutReferenceToPrivateClass:false. ] + position:pos1 to:source position " tokenPosition-1". + ]. + Tools::ToDoListBrowser notNil ifTrue:[ + self + notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1 + className:(self classToCompileFor name) selector:selector + severity:#warning priority:#medium + equalityParameter:nil + checkAction:nil. + ]. + ]. + ]. + ] + ]. + ] + ] + ]. + ]. + pos2 := source position. + self nextToken. + ]. + var := VariableNode globalNamed:globlName. + var startPosition: pos1 endPosition: pos2. + parseForCode ifFalse:[self rememberGlobalUsed:globlName]. + ]. + self markVariable:var from:pos1 to:pos1 + rawName size - 1 assigned:false. ]. var == #Error ifTrue:[ - ^ #Error + ^ #Error ]. "/ errorFlag ~~ true ifTrue:[ "/ self markVariable:var from:pos1 to:pos1 + varName size - 1. "/ ]. (ignoreErrors or:[parseForCode not and:[ignoreWarnings]]) ifTrue:[ - errorFlag := false. + errorFlag := false. ]. ((tokenType ~~ $_) and:[tokenType ~~ #':=']) ifTrue:[ - parseForCode ifFalse:[ - var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name]. - var isClassVariable ifTrue:[ self rememberClassVarRead:var name]. - var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name]. - var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name]. - ]. - ^ var + parseForCode ifFalse:[ + var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name]. + var isClassVariable ifTrue:[ self rememberClassVarRead:var name]. + var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name]. + var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name]. + ]. + ^ var ]. "/ assignment... (usedGlobals notNil and:[usedGlobals includes:(Smalltalk undeclaredPrefix,var name)]) ifFalse:[ - self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1. + self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1. ]. "/ careful: it could already be an implicit self send parserFlags implicitSelfSends ifTrue:[ - var isMessage ifTrue:[ - self nextToken. - expr := self expression. - self isSyntaxHighlighter ifFalse:[ - (errorFlag or:[expr == #Error]) ifTrue:[^ #Error]. - ]. - ^ MessageNode receiver:(self selfNode) selector:('__' , varName , ':') asSymbol arg:expr. - ]. + var isMessage ifTrue:[ + self nextToken. + expr := self expression. + self isSyntaxHighlighter ifFalse:[ + (errorFlag or:[expr == #Error]) ifTrue:[^ #Error]. + ]. + ^ MessageNode receiver:(self selfNode) selector:('__' , varName) asMutator arg:expr. + ]. ]. assignmentAllowed := true. (var ~~ #Error) ifTrue:[ - t := var type. - t == #MethodVariable ifTrue:[ - self rememberLocalModified:var name. - ] ifFalse:[ (t == #InstanceVariable) ifTrue:[ - varName := self classesInstVarNames at:(var index). - - classToCompileFor isMeta ifTrue:[ - "/ ca once assigned to "name" on the class side and wondered what happened to his class ... - "/ (not really a beginners bug, but may happen as a typo or missing local variable; - "/ and is hard to track down later) - ignoreWarnings ifFalse:[ - parserFlags warnings ifTrue:[ - parserFlags warnCommonMistakes ifTrue:[ - (classToCompileFor isSubclassOf:Class) ifTrue:[ - (Class allInstVarNames includes:(var name)) ifTrue:[ - self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2. - ] - ] - ] - ]. - ]. - ]. - - parseForCode ifFalse:[ - self rememberInstVarModified:varName - ] - ] ifFalse:[ (t == #ClassVariable) ifTrue:[ - varName := var name. - varName := varName copyFrom:((varName indexOf:$:) + 1). - parseForCode ifFalse:[ - self rememberClassVarModified:varName - ] - ] ifFalse:[ (t == #GlobalVariable) ifTrue:[ - (cls := Smalltalk classNamed:var name) notNil ifTrue:[ - cls name = var name ifTrue:[ - self warning:'assignment to global which refers to a class' position:pos1 to:pos2. - ] - ]. - parseForCode ifFalse:[ - self rememberGlobalModified:var name - ] - ] ifFalse:[ - (t == #PrivateClass) ifTrue:[ - assignmentAllowed := false. - self parseError:'assignment to private class' position:pos1 to:pos2. - ] ifFalse:[ (t == #MethodArg) ifTrue:[ - (assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[ - parserFlags warnAssignmentToMethodArgument ifTrue:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags warnAssignmentToMethodArgument:false. - parserFlags warnAssignmentToMethodArgument:false. - ex proceed. - ] do:[ - self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. - ] - ] - ] ifFalse:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags allowAssignmentToMethodArgument:true. - ParserFlags allowAssignmentToMethodArgument:true. - ex proceed. - ] do:[ - self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2. - errorFlag := false. "ok, user wants it - so he'll get it" - assignmentAllowed := true. "/ if proceeded - ]. - ] - ] ifFalse:[ (t == #BlockArg) ifTrue:[ - (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[ - parserFlags warnAssignmentToBlockArgument ifTrue:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags warnAssignmentToBlockArgument:false. - parserFlags warnAssignmentToBlockArgument:false. - ex proceed. - ] do:[ - self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. - ] - ]. - ] ifFalse:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags allowAssignmentToBlockArgument:true. - ParserFlags allowAssignmentToBlockArgument:true. - ex proceed. - ] do:[ - self parseError:'assignment to block argument.' position:pos1 to:pos2. - ] - ]. - errorFlag := false. "ok, user wants it - so he'll get it" - assignmentAllowed := true. "/ if proceeded - ] ifFalse:[ (t == #PoolVariable) ifTrue:[ - self isDoIt ifTrue:[ - self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. - assignmentAllowed := true. - ] ifFalse:[ - (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[ - parserFlags warnAssignmentToPoolVariable ifTrue:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags warnAssignmentToPoolVariable:false. - ParserFlags warnAssignmentToPoolVariable:false. - ex proceed. - ] do:[ - self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. - ] - ] - ] ifFalse:[ - DoNotShowCompilerWarningAgainActionQuery handle:[:ex | - parserFlags allowAssignmentToPoolVariable:true. - ParserFlags allowAssignmentToPoolVariable:true. - ex proceed. - ] do:[ - self parseError:'assignment to pool variable' position:pos1 to:pos2. - ]. - errorFlag := false. "ok, user wants it - so he'll get it" - assignmentAllowed := true. "/ if proceeded - parseForCode ifFalse:[ - self rememberPoolVarModified:var name - ] - ]. - ] - ]]]]]]] - ]. + t := var type. + t == #MethodVariable ifTrue:[ + self rememberLocalModified:var name. + ] ifFalse:[ (t == #InstanceVariable) ifTrue:[ + varName := self classesInstVarNames at:(var index). + + classToCompileFor isMeta ifTrue:[ + "/ ca once assigned to "name" on the class side and wondered what happened to his class ... + "/ (not really a beginners bug, but may happen as a typo or missing local variable; + "/ and is hard to track down later) + ignoreWarnings ifFalse:[ + parserFlags warnings ifTrue:[ + parserFlags warnCommonMistakes ifTrue:[ + (classToCompileFor isSubclassOf:Class) ifTrue:[ + (Class allInstVarNames includes:(var name)) ifTrue:[ + self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2. + ] + ] + ] + ]. + ]. + ]. + + parseForCode ifFalse:[ + self rememberInstVarModified:varName + ] + ] ifFalse:[ (t == #ClassVariable) ifTrue:[ + varName := var name. + varName := varName copyFrom:((varName indexOf:$:) + 1). + parseForCode ifFalse:[ + self rememberClassVarModified:varName + ] + ] ifFalse:[ (t == #GlobalVariable) ifTrue:[ + (cls := Smalltalk classNamed:var name) notNil ifTrue:[ + cls name = var name ifTrue:[ + self warning:'assignment to global which refers to a class' position:pos1 to:pos2. + ] + ]. + parseForCode ifFalse:[ + self rememberGlobalModified:var name + ] + ] ifFalse:[ + (t == #PrivateClass) ifTrue:[ + assignmentAllowed := false. + self parseError:'assignment to private class' position:pos1 to:pos2. + ] ifFalse:[ (t == #MethodArg) ifTrue:[ + (assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[ + parserFlags warnAssignmentToMethodArgument ifTrue:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags warnAssignmentToMethodArgument:false. + parserFlags warnAssignmentToMethodArgument:false. + ex proceed. + ] do:[ + self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. + ] + ] + ] ifFalse:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags allowAssignmentToMethodArgument:true. + ParserFlags allowAssignmentToMethodArgument:true. + ex proceed. + ] do:[ + self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2. + errorFlag := false. "ok, user wants it - so he'll get it" + assignmentAllowed := true. "/ if proceeded + ]. + ] + ] ifFalse:[ (t == #BlockArg) ifTrue:[ + (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[ + parserFlags warnAssignmentToBlockArgument ifTrue:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags warnAssignmentToBlockArgument:false. + parserFlags warnAssignmentToBlockArgument:false. + ex proceed. + ] do:[ + self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. + ] + ]. + ] ifFalse:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags allowAssignmentToBlockArgument:true. + ParserFlags allowAssignmentToBlockArgument:true. + ex proceed. + ] do:[ + self parseError:'assignment to block argument.' position:pos1 to:pos2. + ] + ]. + errorFlag := false. "ok, user wants it - so he'll get it" + assignmentAllowed := true. "/ if proceeded + ] ifFalse:[ (t == #PoolVariable) ifTrue:[ + self isDoIt ifTrue:[ + self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. + assignmentAllowed := true. + ] ifFalse:[ + (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[ + parserFlags warnAssignmentToPoolVariable ifTrue:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags warnAssignmentToPoolVariable:false. + ParserFlags warnAssignmentToPoolVariable:false. + ex proceed. + ] do:[ + self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2. + ] + ] + ] ifFalse:[ + DoNotShowCompilerWarningAgainActionQuery handle:[:ex | + parserFlags allowAssignmentToPoolVariable:true. + ParserFlags allowAssignmentToPoolVariable:true. + ex proceed. + ] do:[ + self parseError:'assignment to pool variable' position:pos1 to:pos2. + ]. + errorFlag := false. "ok, user wants it - so he'll get it" + assignmentAllowed := true. "/ if proceeded + parseForCode ifFalse:[ + self rememberPoolVarModified:var name + ] + ]. + ] + ]]]]]]] + ]. ]. lnr := tokenLineNr. @@ -7797,32 +7797,32 @@ "/ does not what a beginner might think. self isSyntaxHighlighter ifTrue:[ - (expr == #Error) ifTrue:[^ #Error]. + (expr == #Error) ifTrue:[^ #Error]. ] ifFalse:[ - (errorFlag or:[expr == #Error]) ifTrue:[^ #Error]. - - (ignoreWarnings not - and:[ parserFlags warnings ]) ifTrue:[ - parserFlags warnCommonMistakes ifTrue:[ - (expr ~~ #Error and:[expr isSuper]) ifTrue:[ - self warning:'followup messageSends to "' , var name , '" will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos1 to:pos2. - ]. - ]. - - expr isVariable ifTrue:[ - expr name = var name ifTrue:[ - self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1. - ]. - ]. - ]. + (errorFlag or:[expr == #Error]) ifTrue:[^ #Error]. + + (ignoreWarnings not + and:[ parserFlags warnings ]) ifTrue:[ + parserFlags warnCommonMistakes ifTrue:[ + (expr ~~ #Error and:[expr isSuper]) ifTrue:[ + self warning:'followup messageSends to "' , var name , '" will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos1 to:pos2. + ]. + ]. + + expr isVariable ifTrue:[ + expr name = var name ifTrue:[ + self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1. + ]. + ]. + ]. ]. assignmentAllowed ifTrue:[ - node := AssignmentNode variable:var expression:expr. - parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr]. - node := self assignmentRewriteHookFor:node. + node := AssignmentNode variable:var expression:expr. + parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr]. + node := self assignmentRewriteHookFor:node. ] ifFalse:[ - self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1. - node := expr. + self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1. + node := expr. ]. ^ node @@ -8963,25 +8963,25 @@ type := token. type ~= 'pragma:' ifTrue:[ - self parseError:'pragma expected'. - ^ #self + self parseError:'pragma expected'. + ^ #self ]. self nextToken. ((token = '+') or:[token = '-']) ifTrue:[ - flagValue := (token = '+'). - self nextToken. - (tokenType == #Identifier) ifTrue:[ - token = 'arrayIndexSyntaxExtension' ifTrue:[ - parserFlags perform:('allow',token asUppercaseFirst,':') asSymbol with:flagValue. - self nextToken. - self checkForClosingAngle. - ^ self. - ]. - ]. - self breakPoint:#cg. - self parseError:'unknown pragma'. - ^ self + flagValue := (token = '+'). + self nextToken. + (tokenType == #Identifier) ifTrue:[ + token = 'arrayIndexSyntaxExtension' ifTrue:[ + parserFlags perform:('allow',token asUppercaseFirst) asMutator with:flagValue. + self nextToken. + self checkForClosingAngle. + ^ self. + ]. + ]. + self breakPoint:#cg. + self parseError:'unknown pragma'. + ^ self ]. self parseError:'+/- expected'. @@ -11827,11 +11827,11 @@ !Parser class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.813 2014-03-05 16:25:03 cg Exp $' + ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.814 2014-03-05 22:12:46 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.813 2014-03-05 16:25:03 cg Exp $' + ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.814 2014-03-05 22:12:46 cg Exp $' ! version_SVN