tests/PPObjectTest.st
author sr
Wed, 04 Jul 2018 15:30:19 +0200
changeset 611 38338f2de417
parent 568 f63668a781b1
permissions -rw-r--r--
build order was wrong
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
568
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:goodies/petitparser/tests' }"
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
"{ NameSpace: Smalltalk }"
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
PPAbstractParserTest subclass:#PPObjectTest
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
	instanceVariableNames:''
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
	classVariableNames:''
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
	poolDictionaries:''
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
	category:'PetitTests-Tests'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
!PPObjectTest methodsFor:'parsers'!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
integer
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	^ PPPredicateObjectParser
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
		on: [ :each | each isInteger ]
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
		message: 'integer expected'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
string
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
	^ PPPredicateObjectParser
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
		on: [ :each | each isString ]
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
		message: 'string expected'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
! !
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
!PPObjectTest methodsFor:'testing'!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
testInteger
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
	self assert: self integer parse: #(123) to: 123.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
	self assert: self integer fail: #('abc')
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
testString
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
	self assert: self string parse: #('abc') to: 'abc'.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
	self assert: self string fail: #(123)
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
! !
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
!PPObjectTest methodsFor:'testing-fancy'!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
testFibonacci
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
	"This parser accepts fibonacci sequences with arbitrary start pairs."
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
	
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
	| parser |
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
	parser := ((self integer , self integer) end ==> [ :pair | pair first + pair last ])
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
		/ (self integer , (self integer , self integer) and >=> [ :stream :continuation |
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
			| result |
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
			result := continuation value.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
			(result isPetitFailure or: [ result first + result last first ~= result last last ])
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
				ifFalse: [ parser parseOn: stream ]
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
				ifTrue: [ PPFailure message: 'invalid fibonacci sequence' at: stream position ] ]).
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
	self assert: parser parse: #(1 1) to: 2.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
	self assert: parser parse: #(1 1 2) to: 3.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
	self assert: parser parse: #(1 1 2 3) to: 5.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
	self assert: parser parse: #(1 1 2 3 5) to: 8.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
	self assert: parser parse: #(1 1 2 3 5 8) to: 13.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
	self assert: parser parse: #(1 1 2 3 5 8 13) to: 21.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
	self assert: parser fail: #().
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
	self assert: parser fail: #(1).
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
	self assert: parser fail: #(1 2 3 4) end: 2
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
	
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
! !
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
!PPObjectTest methodsFor:'testing-operators'!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
testChoice
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
	| parser |
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
	parser := self integer / self string.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
	self assert: parser parse: #(123) to: 123.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
	self assert: parser parse: #('abc') to: 'abc'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
testSequence
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    74
	| parser |
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    75
	parser := self integer , self string.
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    76
	self assert: parser parse: #(123 'abc') to: #(123 'abc').
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    77
	self assert: parser fail: #(123 456).
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    78
	self assert: parser fail: #('abc' 'def').
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    79
	self assert: parser fail: #('abc' 123)
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    80
	
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
! !
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
!PPObjectTest class methodsFor:'documentation'!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    84
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
version
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
    ^ '$Header$'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    87
!
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    88
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    89
version_CVS
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    90
    ^ '$Header$'
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
! !
f63668a781b1 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    92