"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"

"{ NameSpace: Smalltalk }"

PPAbstractParserTest subclass:#PPCSmalltalkVerificationTest
	instanceVariableNames:'parser result context resource fileResources'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Extras-Tests-Smalltalk'
!

!PPCSmalltalkVerificationTest class methodsFor:'as yet unclassified'!

isAbstract
    ^ self name = #PPCSmalltalkVerificationTest
!

resources
    ^ (OrderedCollection with: PPCResources)
        addAll: super resources;
        yourself
! !

!PPCSmalltalkVerificationTest methodsFor:'accessing'!

compiledSmalltalkGrammar
    ^ self compiledSmalltalkGrammarClass new
!

compiledSmalltalkGrammarClass
    self subclassResponsibility 
!

smalltalkGrammar
    ^ PPSmalltalkGrammar new
! !

!PPCSmalltalkVerificationTest methodsFor:'setup'!

setUp
    super setUp.
    fileResources := (self resources detect: [:e | e = PPCResources ]) current.
!

tearDown
    super tearDown.
    "
    self compiledSmalltalkGrammarClass isNil ifFalse:[ 
        self compiledSmalltalkGrammarClass removeFromSystem
    ].
    "
! !

!PPCSmalltalkVerificationTest methodsFor:'tests'!

testSmalltalk
    | compiledParser normalParser expected actual |
    normalParser := self smalltalkGrammar.
    compiledParser := self compiledSmalltalkGrammar.
    
    fileResources smalltalkSourcesBig do: [ :source |
        expected := normalParser parse: source.
        expected isPetitFailure ifFalse: [ 
     		actual := (compiledParser parse: source withContext: self context). 
            self assert: expected equals: actual.
        ]
    ].
!

testSmalltalkClass
    | compiledParser normalParser |
    normalParser := self smalltalkGrammar.
    compiledParser := self compiledSmalltalkGrammar.
    
    fileResources smalltalkClassMethods do: [ :source |
        self assert: (normalParser parse: source) 
              equals: (compiledParser parse: source withContext: self context). 
    ].
!

testSmalltalkObject
    | compiledParser normalParser |
    normalParser := self smalltalkGrammar.
    compiledParser := self compiledSmalltalkGrammar.
    
    fileResources smalltalkObjectMethods do: [ :source |
        self assert: (normalParser parse: source) 
              equals: (compiledParser parse: source withContext: self context). 
    ].
! !