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

     2 

     3 TestCase subclass:#PPContextTest

     4 	instanceVariableNames:'context'

     5 	classVariableNames:''

     6 	poolDictionaries:''

     7 	category:'PetitTests-Tests'

     8 !

     9 

    10 !PPContextTest methodsFor:'as yet unclassified'!

    11 

    12 context

    13 	^ PPContext new

    14 !

    15 

    16 setUp

    17 	context := self context.

    18 ! !

    19 

    20 !PPContextTest methodsFor:'tests'!

    21 

    22 testFurthestFailure

    23 	| f1 f2 |

    24 	

    25 	f1 := PPFailure message: #foo context: context at: 1.

    26 	self assert: context furthestFailure = f1.	

    27 	f2 := PPFailure message: #foo context: context at: 1.

    28 	self assert: context furthestFailure = f1.	

    29 	f2 := PPFailure message: #foo context: context at: 3.

    30 	self assert: context furthestFailure = f2.

    31 !

    32 

    33 testMemoization

    34 	| stream memento memento2 collection |

    35 	stream := 'abc' asPetitStream.

    36 	context := context stream: stream.

    37 	collection := OrderedCollection new.

    38 

    39 	context propertyAt: #foo put: collection.

    40 	

    41 	memento := context remember.

    42 	

    43 	self assert: memento isNil not.

    44 	

    45 	context next.

    46 	collection add: #element.

    47 	self assert: (context propertyAt: #foo) size = 1. 	

    48 

    49 	memento2 := context remember.

    50 

    51 	context restore: memento.

    52 	self assert: (context propertyAt: #foo) size = 0. 

    53 	self assert: context position = 0.

    54 	

    55 	context restore: memento2.

    56 	self assert: (context propertyAt: #foo) size = 1. 

    57 	self assert: context position = 1.

    58 !

    59 

    60 testMemoization2

    61 	| stream memento |

    62 	stream := 'abc' asPetitStream.

    63 	context := context stream: stream.

    64 	

    65 	memento := context remember.

    66 	

    67 	context next.

    68 	self assert: context position = 1.

    69 	

    70 	context restore: memento.

    71 	self assert: context position = 0.

    72 !

    73 

    74 testPutGlobals

    75 	self assert: (context hasGlobal: #foo) not.

    76 	self assert: (context hasGlobal: #bar) not.	

    77 	

    78 	self should: [ context globalAt: #foo ] raise: Error.

    79 	self assert: (context globalAt: #foo ifAbsent: [ #bar ]) = #bar.

    80 	

    81 	self assert: (context globalAt: #foo ifAbsentPut: [ #bar ]) = #bar.	

    82 	self assert: (context hasGlobal: #foo).

    83 	self assert: (context hasGlobal: #bar) not.	

    84 	self assert: (context globalAt: #foo) = #bar.

    85 	

    86 	self assert: (context globalAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	

    87 	self assert: (context hasGlobal: #foo).

    88 	self assert: (context hasGlobal: #bar) not.	

    89 	self assert: (context globalAt: #foo) = #bar.

    90 	

    91 	self assert: (context globalAt: #foo put: #zorg) = #zorg.	

    92 	self assert: (context hasGlobal: #foo).

    93 	self assert: (context hasGlobal: #bar) not.	

    94 	self assert: (context globalAt: #foo) = #zorg.

    95 	

    96 	self should: [ context globalAt: #bar ] raise: Error.

    97 	self assert: (context globalAt: #bar put: #foo) = #foo.

    98 	self assert: (context globalAt: #foo) = #zorg.

    99 	self assert: (context globalAt: #bar) = #foo.

   100 

   101 !

   102 

   103 testPutProperties

   104 	self assert: (context hasProperty: #foo) not.

   105 	self assert: (context hasProperty: #bar) not.	

   106 	

   107 	self should: [ context propertyAt: #foo ] raise: Error.

   108 	self assert: (context propertyAt: #foo ifAbsent: [ #bar ]) = #bar.

   109 	

   110 	self assert: (context propertyAt: #foo ifAbsentPut: [ #bar ]) = #bar.	

   111 	self assert: (context hasProperty: #foo).

   112 	self assert: (context hasProperty: #bar) not.	

   113 	self assert: (context propertyAt: #foo) = #bar.

   114 	

   115 	self assert: (context propertyAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	

   116 	self assert: (context hasProperty: #foo).

   117 	self assert: (context hasProperty: #bar) not.	

   118 	self assert: (context propertyAt: #foo) = #bar.

   119 	

   120 	self assert: (context propertyAt: #foo put: #zorg) = #zorg.	

   121 	self assert: (context hasProperty: #foo).

   122 	self assert: (context hasProperty: #bar) not.	

   123 	self assert: (context propertyAt: #foo) = #zorg.

   124 	

   125 	self should: [ context propertyAt: #bar ] raise: Error.

   126 	self assert: (context propertyAt: #bar put: #foo) = #foo.

   127 	self assert: (context propertyAt: #foo) = #zorg.

   128 	self assert: (context propertyAt: #bar) = #foo.

   129 

   130 !

   131 

   132 testRemoveGlobals

   133 	context globalAt: #foo put: #zorg.

   134 	context globalAt: #bar put: #qwark.	

   135 

   136 	self assert: (context removeGlobal: #foo) = #zorg.

   137 	self assert: (context removeGlobal: #bar) = #qwark.

   138 	

   139 	self should: [context removeGlobal: #foo] raise: Error.

   140 	self assert: (context removeGlobal: #bar ifAbsent: [ #foobar ]) = #foobar.

   141 !

   142 

   143 testRemoveProperties

   144 	context propertyAt: #foo put: #zorg.

   145 	context propertyAt: #bar put: #qwark.	

   146 

   147 	self assert: (context removeProperty: #foo) = #zorg.

   148 	self assert: (context removeProperty: #bar) = #qwark.

   149 	

   150 	self should: [context removeProperty: #foo] raise: Error.

   151 	self assert: (context removeProperty: #bar ifAbsent: [ #foobar ]) = #foobar.

   152 !

   153 

   154 testStreamProtocol

   155 	context stream: 'hi there' asPetitStream.

   156 	

   157 	self assert: context position = 0.

   158 	self assert: context peek = $h.

   159 	self assert: context uncheckedPeek = $h.

   160 

   161 	self assert: context next = $h.

   162 	self assert: context peek = $i.

   163 	self assert: context uncheckedPeek = $i.

   164 	self assert: context position = 1.

   165 	

   166 	context skip: 2.

   167 	self assert: context position = 3.

   168 	self assert: context peek = $t.

   169 	self assert: context atEnd not.

   170 	

   171 	self assert: (context next: 5) = 'there'.

   172 	self assert: context position = 8.

   173 	self assert: context atEnd.

   174 ! !

   175