"{ Package: 'stx:libcomp' }"
ParseNodeVisitor subclass:#ParseNodeValidator
instanceVariableNames:'stack source'
classVariableNames:''
poolDictionaries:''
category:'System-Compiler-Support'
!
!ParseNodeValidator class methodsFor:'documentation'!
documentation
"
A helper class used to validate parse tree, i.e. parent instvar,
startPosition/endPositions. Useful only for Parser debugging/hacking.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
"
! !
!ParseNodeValidator class methodsFor:'validation'!
validate: aParseNode source: source
^self basicNew validate: aParseNode source: source
"Created: / 27-07-2011 / 13:43:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
validateClass: cls stopOnError: stopOnError
| validate |
validate := [:mth|
[
| src |
src := mth source.
self validate: (Parser parseMethod: src) tree source: src.
] on: Error do:[:ex|
Transcript
cr;
show: mth printString;
show: '...FAILED!!';
cr.
stopOnError ifTrue:[
ex pass
].
].
].
cls theMetaclass methodsDo: validate.
cls theNonMetaclass methodsDo: validate.
"Created: / 01-08-2011 / 12:47:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
validateImage
self validateImage: false.
"Created: / 20-07-2011 / 20:41:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
validateImage: stopOnError
| i |
i := 0.
Smalltalk allClassesDo:[:cls|
cls isLoaded ifTrue:[
i == 50 ifTrue:[
Transcript cr.
i := 0.
].
i := i + 1.
Transcript nextPut:$..
self validateClass: cls stopOnError: stopOnError
].
].
"Created: / 20-07-2011 / 20:42:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNodeValidator methodsFor:'validation'!
validate: tree source: src
tree isNil ifTrue:[^self].
source := src.
stack := Stack with: nil.
^self visit: tree
"Created: / 27-07-2011 / 13:43:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
validateNode:node
self assert: node startPosition isInteger.
self assert: node endPosition isInteger.
self assert: node parent == stack top
"Modified: / 27-07-2011 / 13:47:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNodeValidator methodsFor:'visiting'!
visit:anObject
|accept stmt|
accept :=
[:node |
stack push:node.
node acceptVisitor:self.
stack pop.
self validateNode:node. ].
^ anObject isStatementNode
ifTrue:
[ stmt := anObject.
[ stmt isNil ] whileFalse:
[ accept value:stmt.
stmt := stmt nextStatement. ] ]
ifFalse:[ accept value:anObject. ]
"Created: / 25-07-2011 / 23:14:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visitBlockNode:anObject
self assert: (source at: anObject startPosition) == $[.
self assert: (source at: anObject endPosition) == $].
super visitBlockNode: anObject.
"Modified: / 25-07-2011 / 22:38:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 20-08-2011 / 23:21:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 21-08-2011 / 13:52:50 / cg"
!
visitVariableNode:anObject
| s e |
s := anObject startPosition.
e := anObject endPosition.
(s ~~ -1 and:[e ~~ -1 and:[
#(MethodVariable InstanceVariable) includes: anObject type]]) ifTrue:[
self assert: anObject name =
(source copyFrom: anObject startPosition to: anObject endPosition).
].
super visitVariableNode: anObject.
"Created: / 20-08-2011 / 23:21:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-08-2011 / 13:51:55 / cg"
"Modified: / 25-08-2011 / 14:03:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ParseNodeValidator class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/ParseNodeValidator.st,v 1.8 2011-08-25 13:38:46 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libcomp/ParseNodeValidator.st,v 1.8 2011-08-25 13:38:46 vrany Exp $'
! !