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

"{ NameSpace: Smalltalk }"

TestCase subclass:#PEGFsaTest
	instanceVariableNames:'fsa a b c d e result newFsa'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Tests-FSA'
!

!PEGFsaTest methodsFor:'as yet unclassified'!

assert: col allSatisfy: block
    self assert: (col allSatisfy: block).
!

assert: col anySatisfy: block
    self assert: (col anySatisfy: block).
!

setUp
    a := PEGFsaState new name: #a; retval: #a; yourself.
    b := PEGFsaState new name: #b; retval: #b; yourself.
    c := PEGFsaState new name: #c; retval: #c; yourself.
    d := PEGFsaState new name: #d; retval: #d; yourself.
    e := PEGFsaState new name: #e; retval: #e; yourself.

    fsa := PEGFsa new.
!

testBackTransitions
    fsa addState: a.
    fsa addState: b.
    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: a on: $a.
    fsa addTransitionFrom: a to: b on: $a.
    
    result := fsa backTransitions.
        
    self assert: result size = 1.
    self assert: result anyOne destination = a.
!

testBackTransitions2
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: a on: $a.
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: c on: $a.
    fsa addTransitionFrom: c to: a.
    
    result := fsa backTransitions.
        
    self assert: result size = 2.
    self assert: result allSatisfy: [:t | t destination = a ].
!

testBackTransitions3
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $a.
    fsa addTransitionFrom: b to: d on: $a.
    fsa addTransitionFrom: c to: d on: $a.
    fsa addTransitionFrom: d to: b on: $a.
    fsa addTransitionFrom: d to: c on: $a.
    result := fsa backTransitions.
        
    self assert: result size = 2.

    d transitions allSatisfy: [ :t | result includes: t ].
!

testBackTransitions4
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: c on: $a.
    fsa addTransitionFrom: a to: c on: $a.
    
    result := fsa backTransitions.
        
    self assert: result size = 0.
!

testBackTransitions5
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: c on: $a.
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: c on: $a.
    
    result := fsa backTransitions.
        
    self assert: result size = 0.
!

testDeterminize
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $a.
    
    fsa determinize.
        
    self assert: fsa states size = 2.
    self assert: a transitions size = 1.	
    self assert: a transitions anyOne destination retval = #c.
!

testDeterminize2
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $a.
    
    fsa determinize.
        
    self assert: fsa states size = 2.
    self assert: a transitions size = 1.	
    self assert: a transitions anyOne destination retval = #b.
!

testDeterminize3
    | merged |
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa addState: e.

    fsa startState: a.
    fsa finalState: e.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $a.
    fsa addTransitionFrom: b to: e on: $e.
    fsa addTransitionFrom: c to: d on: $d.
    fsa addTransitionFrom: d to: e on: $e.
    
    fsa determinize.
    merged := a transitions anyOne destination.
        
    self assert: fsa states size = 4.
    self assert: a transitions size = 1.	
    self assert: merged transitions size = 2.
    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $d) and: [ t destination = d ]]).
    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $e) and: [ t destination = e ]]).	
!

testDeterminize4
    | merged |
    fsa addState: a.
    fsa addState: b.

    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: a on: $a.
    fsa addTransitionFrom: a to: b on: $a.
    
    fsa determinize.
    merged := a transitions anyOne destination.
        
    self assert: fsa states size = 2.
    self assert: a transitions size = 1.	
    self assert: merged transitions size = 1.
    self assert: ((merged name = #'a-b') or: [merged name = #'b-a']).
    self assert: (merged transitions anySatisfy: [ :t | (t accepts: $a) and: [ t destination = merged ]]).
!

testDeterminize5
    | merged |
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: a.	
    fsa addTransitionFrom: b to: c priority: -1. 
    fsa addTransitionFrom: c to: d on: $a.
    b priority: 0.
    
    fsa determinize.
    merged := b transitions anyOne destination.
    
    self assert: fsa isDeterministic.	
    self assert: fsa states size = 3.
    
    
    self assert: a transitions size = 1.	
    self assert: b transitions size = 1.	
    self assert: (fsa states noneSatisfy: [ :s | s isFinal ]).
!

testDeterminize6
    |  merged |
    fsa addState: a.
    fsa addState: b.
    
    fsa startState: a.
    fsa finalState: b.

    fsa addTransitionFrom: a to: a on: $a.
    fsa addTransitionFrom: a to: b on: $a priority: -1.	

    fsa determinize.
    self assert: fsa isDeterministic.	
    self assert: fsa states size = 2.
    
    
    self assert: a transitions size = 1.	
    self assert: a isFinal not.
    
    merged := a transitions anyOne destination.
    self assert: merged transitions size = 1.
    self assert: merged isFinal.
!

testIsDeterministic
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b on: $b.
    fsa addTransitionFrom: a to: c on: $c.	

    self assert: fsa isDeterministic.
!

testIsDeterministic2
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $a.	

    self assert: fsa isDeterministic not.
!

testIsWithoutEpsilons
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b.
    fsa addTransitionFrom: b to: c on: $c.	

    self assert: fsa isWithoutEpsilons not.
!

testMergeTransitions
    fsa addState: a.
    fsa addState: b.
    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: b on: $b.	

    fsa mergeTransitions.
        
    self assert: a transitions size = 1.
    self assert: (a transitions anyOne accepts: $a).
    self assert: (a transitions anyOne accepts: $b).
!

testMergeTransitions2
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: a to: c on: $b.	

    fsa mergeTransitions.
        
    self assert: a transitions size = 2.
!

testMinimize
    | merged |
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b on: $b.
    fsa addTransitionFrom: a to: c on: $c.

    fsa addTransitionFrom: b to: d on: $a.
    fsa addTransitionFrom: c to: d on: $a.
    b retval: nil.
    c retval: nil.
    
    fsa minimize.
        
    self assert: fsa states size = 3.
    self assert: a transitions size = 1.	
    
    merged := a transitions anyOne destination.
    self assert: merged transitions size = 1.
    self assert: merged transitions anyOne destination = d.
    self assert: (merged transitions anyOne accepts: $a).
!

testMinimze2
    |  merged |
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa addState: e.
    
    fsa startState: a.
    fsa finalState: e.

    "states c and d are equivalent"
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: c on: $c priority: -1.	
    fsa addTransitionFrom: b to: d on: $d priority: -2.	
    fsa addTransitionFrom: c to: e on: $e priority: -3.	
    fsa addTransitionFrom: d to: e on: $e priority: -4.	
    
    c retval: nil.
    d retval: nil.
    
    fsa minimize.
    
    self assert: fsa isDeterministic.	
    self assert: fsa states size = 4.
    
    self assert: b transitions size = 1.	
    
    merged := b destination.
    self assert: merged transitions size = 1.
    self assert: merged destination isFinal.
!

testRemoveEpsilons
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b.
    fsa addTransitionFrom: b to: c on: $c.	

    fsa removeEpsilons.
        
    self assert: a transitions size = 1.
    self assert: b transitions size = 1.
    self assert: a transitions anyOne isEpsilon not.
    self assert: (a transitions anyOne accepts: $c).
    self assert: (fsa isReachableState: c).
    self assert: (fsa isReachableState: b) not.
    self assert: fsa isWithoutEpsilons.
!

testRemoveEpsilons2
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: b.
    fsa addTransitionFrom: a to: b on: $b.
    fsa addTransitionFrom: b to: c on: $c.	
    
    fsa removeEpsilons.
        
    self assert: a transitions size = 2.
    self assert: b transitions size = 1.
    self assert: (a transitions noneSatisfy: [:t | t isEpsilon ]).
    self assert: (a transitions anySatisfy: [:t | t accepts: $c ]).
    self assert: (a transitions anySatisfy: [:t | t accepts: $b ]).	
!

testRemoveEpsilons3
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b.
    fsa addTransitionFrom: b to: c.	
    fsa addTransitionFrom: c to: d on: $d.	
    
    fsa removeEpsilons.
        
    self assert: a transitions size = 1.

    self assert: a transitions anyOne isEpsilon not.
    self assert: (a transitions anyOne accepts: $d).
    self assert: (fsa isReachableState: d).	
    self assert: (fsa isReachableState: b) not.
    self assert: (fsa isReachableState: c) not.
!

testRemoveEpsilons4
    fsa addState: a.
    fsa addState: b.
    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: b.
    
    fsa removeEpsilons.
        
    self assert: a isFinal.
!

testRemoveEpsilons5
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.


    fsa startState: a.
    fsa finalState: d.

    c priority: 0.
    d priority: 0.
    
    fsa addTransitionFrom: a to: b priority: -1.
    fsa addTransitionFrom: a to: c on: $c.
    fsa addTransitionFrom: b to: d on: $d.
    fsa addTransitionFrom: c to: d on: $d.
    
    fsa removeEpsilons.
            
    self assert: c priority = 0.
    self assert: d priority = -1.
    self assert: (a transitions anySatisfy: [:t | t accepts: $d ]).
!

testRemoveEpsilons6
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: a.	
    fsa addTransitionFrom: b to: c priority: -1. 
    fsa addTransitionFrom: c to: d on: $b.
        
    d priority: 0.	
        
    fsa removeEpsilons.
    
    self assert: fsa isWithoutEpsilons.
        
    self assert: a transitions size = 1.
    self assert: b transitions size = 2.
    self assert: b transitions anySatisfy: [ :t | (t accepts: $a) and: [t destination = b]].
    self assert: b transitions anySatisfy: [ :t | (t accepts: $b) and: [t destination = d]].

    self assert: d priority = -1.	
!

testRemoveEpsilons7
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa addState: d.
    fsa startState: a.
    fsa finalState: d.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: a.	
        
    fsa removeEpsilons.
    
    self assert: fsa isWithoutEpsilons.
        
    self assert: a transitions size = 1.
    self assert: b transitions size = 1.
    self assert: (a transitions anyOne == b transitions anyOne) not.
!

testRemoveLowPriorityTransitions
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: a.
    fsa finalState: b.
    fsa finalState: c.

    b priority: 0.	
    fsa addTransitionFrom: a to: b on: $a priority: -1.
    fsa addTransitionFrom: b to: c on: $b priority: -1.
        
    fsa removeLowPriorityTransitions.
    
    self assert: fsa isWithoutEpsilons.
        
    self assert: a transitions size = 1.
    self assert: b transitions size = 0.
!

testRemoveUnreachableStates
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    fsa startState: a.
    fsa finalState: c.
    
    fsa addTransitionFrom: a to: c.
    fsa addTransitionFrom: b to: c.
    
    fsa removeUnreachableStates.
        
    self assert: fsa states size = 2.
!

testTopologicalOrder
    |  |
    fsa addState: a.
    fsa addState: b.

    fsa startState: a.
    fsa finalState: b.
    
    fsa addTransitionFrom: a to: a on: $a.
    fsa addTransitionFrom: a to: b on: $a.
    
    result := fsa topologicalOrder.
            
    self assert: result first == a.
    self assert: result second == b.
! !

!PEGFsaTest methodsFor:'tests - copy'!

testCopy
    | newA newC |
    fsa addState: a.
    fsa addState: b.
    fsa addState: c.
    
    fsa finalState: c.
    fsa startState: a.
    
    fsa addTransitionFrom: a to: b on: $a.
    fsa addTransitionFrom: b to: c on: $b priority: -1.
    fsa addTransitionFrom: c to: a priority: -2.
    
    newFsa := fsa copy.
    
    self assert: (fsa isIsomorphicTo: newFsa).
    
    newA := newFsa states detect: [ :s | s canBeIsomorphicTo: a ].

    self assert: newFsa startState = newA.
    self assert: (a == newA) not.
    self assert: (newA transitions anyOne canBeIsomorphicTo: a transitions anyOne).
    self assert: (newA transitions anyOne == a transitions anyOne) not.
    self assert: newA destination destination destination == newA.
    
    newC := newA destination destination.
    self assert: (newC == c) not.
    self assert: newC isFinal.
    self assert: newC retval = #c.
! !