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

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 PPAbstractParserTest subclass:#PPCSmalltalkVerificationTest

     6 	instanceVariableNames:'parser result context resource fileResources'

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'PetitCompiler-Extras-Tests-Smalltalk'

    10 !

    11 

    12 !PPCSmalltalkVerificationTest class methodsFor:'as yet unclassified'!

    13 

    14 isAbstract

    15     ^ self name = #PPCSmalltalkVerificationTest

    16 !

    17 

    18 resources

    19     ^ (OrderedCollection with: PPCResources)

    20         addAll: super resources;

    21         yourself

    22 ! !

    23 

    24 !PPCSmalltalkVerificationTest methodsFor:'accessing'!

    25 

    26 compiledSmalltalkGrammar

    27     ^ self compiledSmalltalkGrammarClass new

    28 !

    29 

    30 compiledSmalltalkGrammarClass

    31     self subclassResponsibility 

    32 !

    33 

    34 smalltalkGrammar

    35     ^ PPSmalltalkGrammar new

    36 ! !

    37 

    38 !PPCSmalltalkVerificationTest methodsFor:'setup'!

    39 

    40 setUp

    41     super setUp.

    42     fileResources := (self resources detect: [:e | e = PPCResources ]) current.

    43 !

    44 

    45 tearDown

    46     super tearDown.

    47     "

    48     self compiledSmalltalkGrammarClass isNil ifFalse:[ 

    49         self compiledSmalltalkGrammarClass removeFromSystem

    50     ].

    51     "

    52 ! !

    53 

    54 !PPCSmalltalkVerificationTest methodsFor:'tests'!

    55 

    56 testSmalltalk

    57     | compiledParser normalParser expected actual |

    58     normalParser := self smalltalkGrammar.

    59     compiledParser := self compiledSmalltalkGrammar.

    60     

    61     fileResources smalltalkSourcesBig do: [ :source |

    62         expected := normalParser parse: source.

    63         expected isPetitFailure ifFalse: [ 

    64      		actual := (compiledParser parse: source withContext: self context). 

    65             self assert: expected equals: actual.

    66         ]

    67     ].

    68 !

    69 

    70 testSmalltalkClass

    71     | compiledParser normalParser |

    72     normalParser := self smalltalkGrammar.

    73     compiledParser := self compiledSmalltalkGrammar.

    74     

    75     fileResources smalltalkClassMethods do: [ :source |

    76         self assert: (normalParser parse: source) 

    77               equals: (compiledParser parse: source withContext: self context). 

    78     ].

    79 !

    80 

    81 testSmalltalkObject

    82     | compiledParser normalParser |

    83     normalParser := self smalltalkGrammar.

    84     compiledParser := self compiledSmalltalkGrammar.

    85     

    86     fileResources smalltalkObjectMethods do: [ :source |

    87         self assert: (normalParser parse: source) 

    88               equals: (compiledParser parse: source withContext: self context). 

    89     ].

    90 ! !

    91