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 comment:''

    13 !

    14 

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

    16 

    17 isAbstract

    18     ^ self name = #PPCSmalltalkVerificationTest

    19 !

    20 

    21 resources

    22     ^ (OrderedCollection with: PPCResources)

    23         addAll: super resources;

    24         yourself

    25 ! !

    26 

    27 !PPCSmalltalkVerificationTest methodsFor:'accessing'!

    28 

    29 compiledSmalltalkGrammar

    30     ^ self compiledSmalltalkGrammarClass new

    31 !

    32 

    33 compiledSmalltalkGrammarClass

    34     self subclassResponsibility 

    35 !

    36 

    37 smalltalkGrammar

    38     ^ PPSmalltalkGrammar new

    39 ! !

    40 

    41 !PPCSmalltalkVerificationTest methodsFor:'setup'!

    42 

    43 setUp

    44     super setUp.

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

    46 !

    47 

    48 tearDown

    49     super tearDown.

    50     "

    51     self compiledSmalltalkGrammarClass isNil ifFalse:[ 

    52         self compiledSmalltalkGrammarClass removeFromSystem

    53     ].

    54     "

    55 ! !

    56 

    57 !PPCSmalltalkVerificationTest methodsFor:'tests'!

    58 

    59 testSmalltalk

    60     | compiledParser normalParser expected actual |

    61     normalParser := self smalltalkGrammar.

    62     compiledParser := self compiledSmalltalkGrammar.

    63     

    64     fileResources smalltalkSourcesBig do: [ :source |

    65         expected := normalParser parse: source.

    66         expected isPetitFailure ifFalse: [ 

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

    68             self assert: expected equals: actual.

    69         ]

    70     ].

    71 !

    72 

    73 testSmalltalkClass

    74     | compiledParser normalParser |

    75     normalParser := self smalltalkGrammar.

    76     compiledParser := self compiledSmalltalkGrammar.

    77     

    78     fileResources smalltalkClassMethods do: [ :source |

    79         self assert: (normalParser parse: source) 

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

    81     ].

    82 !

    83 

    84 testSmalltalkObject

    85     | compiledParser normalParser |

    86     normalParser := self smalltalkGrammar.

    87     compiledParser := self compiledSmalltalkGrammar.

    88     

    89     fileResources smalltalkObjectMethods do: [ :source |

    90         self assert: (normalParser parse: source) 

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

    92     ].

    93 ! !

    94