--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/PPCUnivarsalGuardTest.st	Mon Aug 24 15:34:14 2015 +0100
@@ -0,0 +1,115 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests' }"
+
+"{ NameSpace: Smalltalk }"
+
+PPAbstractParserTest subclass:#PPCUnivarsalGuardTest
+	instanceVariableNames:'parser result context node compiler id node2 id2 id1 node1 node3
+		arguments configuration'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Tests-Core-Universal'
+!
+
+!PPCUnivarsalGuardTest methodsFor:'as yet unclassified'!
+
+assert: p parse: whatever
+    ^ result := super assert: p parse: whatever.
+!
+
+context	
+    ^ context := PPCProfilingContext new
+!
+
+setUp
+    arguments := PPCArguments default
+        profile: true;
+        yourself.
+        
+    configuration := PPCUniversalConfiguration new
+        arguments: arguments;
+        yourself.
+!
+
+tearDown
+    | parserClass |
+
+    parserClass := (Smalltalk at: #PPGeneratedParser ifAbsent: [nil]).
+    parserClass notNil ifTrue:[ 
+        parserClass removeFromSystem
+    ].
+! !
+
+!PPCUnivarsalGuardTest methodsFor:'tests - guard'!
+
+testChoiceGuard
+    parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken plus) 
+        compileWithConfiguration: configuration.
+    
+    self assert: parser parse: 'foo'.
+    self assert: result inputValue = 'foo'.	
+    self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'token' ]).
+
+    self assert: parser parse: 'bar'.
+    self assert: result inputValue = 'bar'.	
+
+    self assert: parser parse: ' foo'.
+    self assert: result inputValue = 'foo'.	
+
+    self assert: parser parse: '  d'.
+    self assert: result first inputValue = 'd'.	
+
+    self assert: parser fail: ''.
+    self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'predicate' ]).
+    self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+
+    self assert: parser fail: 'zorg'.		
+    self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'token' ]).
+!
+
+testEmptyChoiceGuard
+    parser := ('foo' asParser trimmingToken / 'bar' asParser trimmingToken / $d asParser trimmingToken star) 
+        compileWithConfiguration: configuration.
+    
+    self assert: parser parse: 'foo'.
+    self assert: result inputValue = 'foo'.	
+
+    self assert: parser parse: 'bar'.
+    self assert: result inputValue = 'bar'.	
+
+    self assert: parser parse: ' foo'.
+    self assert: result inputValue = 'foo'.	
+
+    self assert: parser parse: '  d'.
+    self assert: result first inputValue = 'd'.	
+
+    self assert: parser parse: ''.
+
+    self assert: parser parse: 'zorg' end: 0.	
+!
+
+testGuardSmalltlakToken
+    parser := (#letter asParser, #word asParser star) smalltalkToken compileWithConfiguration: configuration.
+    
+    self assert: parser parse: 'bar'.
+    self assert: (context invocations anySatisfy: [ :e | e beginsWith: 'seq' ]).
+    
+    self assert: parser fail: '123'.
+    self assert: (context invocations noneSatisfy: [ :e | e beginsWith: 'seq' ]).
+!
+
+testSequenceGuard
+    parser := ((#any asParser, #any asParser) wrapped, (#any asParser, #any asParser)) compileWithConfiguration: configuration.
+    
+    self assert: parser parse: 'fooo' to: #(#($f $o) #($o $o)).	
+    self assert: parser parse: 'fo oo' to: #(#($f $o) #($  $o)) end: 4.	
+    self assert: parser fail: 'fo'.
+    
+!
+
+testTrimmerGuard
+    parser := $a asParser trim, $b asParser compileWithConfiguration: configuration.
+    
+    self assert: parser parse: 'ab'.
+    self assert: parser parse: ' ab'.
+! !
+