Tests refactoring - use generated test cases to make sure all posibilities are tested.
Do not generate resource for all combinations, use PPCSetUpBeforeTearDownAfterResource
instead that delegates parser compilation to the testcase itself (it calls it's #setUpBefore
method).
"{ Package: 'stx:goodies/petitparser' }"
"{ NameSpace: Smalltalk }"
PPPredicateParser subclass:#PPPredicateObjectParser
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'PetitParser-Parsers'
!
PPPredicateObjectParser class instanceVariableNames:'cache'
"
No other class instance variables are inherited by this class.
"
!
!PPPredicateObjectParser class methodsFor:'instance creation'!
on: aBlock message: aString
^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString
!
on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
!
startOfLine
^ PPStartOfLineParser new.
! !
!PPPredicateObjectParser class methodsFor:'cache'!
cacheAt: aSymbol ifAbsentPut: aBlock
cache ifNil: [ ^aBlock value ].
^(cache
at: aSymbol
ifAbsentPut: aBlock) copy
!
useCache: aBoolean
"
PPPredicateObjectParser useCache: true.
PPPredicateObjectParser useCache: false.
"
cache := aBoolean
ifTrue: [ Dictionary new ]
ifFalse: [ nil ]
! !
!PPPredicateObjectParser class methodsFor:'factory-chars'!
blank
^self
cacheAt: #'blank'
ifAbsentPut: [ self
chars: (String with: Character space with: Character tab) message: 'blank expected' ]
!
char: aCharacter
^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'
!
char: aCharacter message: aString
^ self expect: aCharacter message: aString
!
chars: aCollection message: aString
^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString
!
cr
^self
cacheAt: #'cr'
ifAbsentPut: [ self char: (Character codePoint: 13) message: 'carriage return expected' ]
!
digit
^self
cacheAt: #'digit'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' ]
!
hex
^self
cacheAt: #'hex'
ifAbsentPut: [ self
on: (PPCharSetPredicate on: [ :char |
(char between: $0 and: $9)
or: [ (char between: $a and: $f)
or: [ (char between: $A and: $F) ] ] ])
message: 'hex digit expected' ]
!
letter
^self
cacheAt: #'letter'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' ]
!
lf
^self
cacheAt: #'lf'
ifAbsentPut: [ self char: (Character codePoint: 10) ]
!
lowercase
^self
cacheAt: #'lowercase'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected' ]
!
newline
^self
cacheAt: #'newline'
ifAbsentPut: [ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' ]
!
punctuation
^self
cacheAt: #'punctuation'
ifAbsentPut: [ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' ]
!
space
^self
cacheAt: #'space'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' ]
!
tab
^self
cacheAt: #'tab'
ifAbsentPut: [ self char: Character tab message: 'tab expected' ]
!
uppercase
^self
cacheAt: #'uppercase'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' ]
!
word
^self
cacheAt: #'word'
ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected' ]
! !
!PPPredicateObjectParser class methodsFor:'factory-objects'!
any
^self
cacheAt: #'any'
ifAbsentPut: [ self
on: [ :each | true ] message: 'input expected'
negated: [ :each | false ] message: 'no input expected' ]
!
anyExceptAnyOf: aCollection
^ self
on: [ :each | (aCollection includes: each) not ] message: 'any except ' , aCollection printString , ' expected'
negated: [ :each | aCollection includes: each ] message: aCollection printString , ' not expected'
!
anyOf: aCollection
^ self
on: [ :each | aCollection includes: each ] message: 'any of ' , aCollection printString , ' expected'
negated: [ :each | (aCollection includes: each) not ] message: 'none of ' , aCollection printString , 'expected'
!
between: min and: max
^ self
on: [ :each | each >= min and: [ each <= max ] ] message: min printString , '..' , max printString , ' expected'
negated: [ :each | each < min or: [ each > max ] ] message: min printString , '..' , max printString , ' not expected'
!
endOfLine
^ PPEndOfLineParser new.
!
eof
^ PPEndOfFileParser new
!
expect: anObject
^ self expect: anObject message: anObject printString , ' expected'
!
expect: anObject message: aString
^ self
on: [ :each | each = anObject ] message: aString
negated: [ :each | each ~= anObject ] message: 'no ' , aString
!
startOfLogicalLine
^ PPStartOfLogicalLineParser new.
!
startOfWord
^ PPStartOfWordParser new.
! !
!PPPredicateObjectParser methodsFor:'initialization'!
initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
predicate := aBlock.
predicateMessage := aString.
negated := aNegatedBlock.
negatedMessage := aNegatedString
! !
!PPPredicateObjectParser methodsFor:'operators'!
negate
"Answer a parser that is the negation of the receiving predicate parser."
^ self class
on: negated message: negatedMessage
negated: predicate message: predicateMessage
! !
!PPPredicateObjectParser methodsFor:'parsing'!
parseOn: aPPContext
^ (aPPContext atEnd not and: [ predicate value: aPPContext uncheckedPeek ])
ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
ifTrue: [ aPPContext next ]
! !
!PPPredicateObjectParser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/petitparser/PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id: PPPredicateObjectParser.st,v 1.5 2014-03-04 14:33:20 cg Exp $'
! !