SystemOrganization addCategory: #'PetitXml-Core'!
SystemOrganization addCategory: #'PetitXml-Support'!
SystemOrganization addCategory: #'PetitXml-Tests'!
PPParser subclass: #PPXmlNamespaceParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Support'!
PPParser subclass: #PPXmlTagParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Support'!
!PPXmlTagParser methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:09'!
parse: aStream! !
TestResource subclass: #PPXmlResource
instanceVariableNames: 'parsers'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:55'!
allXsdDefinitions
^ (self class organization listAtCategoryNamed: #'accessing-xsd')
collect: [ :each | self perform: each ]! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
elementFormXsd
^ '
-->
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
elementReferencesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
externalAttributesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
forwardRefXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:52'!
getBalanceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
groupXsd
^ '
A price is any one of the following:
* Full Price (with amount)
* Sale Price (with amount and authorization)
* Clearance Price (with amount and authorization)
* Free (with authorization)
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
importAuxXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
importBaseXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:50'!
includeWithNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 13:50'!
includeWithoutNamespaceXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
listXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
mixedContentXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
notationXsd
^ '
Location of the corporate logo.
Location of the corporate mascot.
'! !
!PPXmlResource methodsFor: 'accessing' stamp: 'lr 1/26/2010 13:21'!
parserAt: aClass
^ parsers
at: aClass name
ifAbsentPut: [ aClass new ]! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
restrictionXsd
^ '
'! !
!PPXmlResource methodsFor: 'running' stamp: 'lr 1/7/2010 13:39'!
setUp
super setUp.
parsers := Dictionary new! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:06'!
simpleContentExtensionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
subgroupXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
unionXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/7/2010 14:07'!
unqualifiedTypesXsd
^ '
'! !
!PPXmlResource methodsFor: 'accessing-xsd' stamp: 'lr 1/26/2010 12:57'!
xsdXsd
^ '
]>
The schema corresponding to this document is normative,
with respect to the syntactic constraints it expresses in the
XML Schema Definition Language. The documentation (within <documentation> elements)
below, is not normative, but rather highlights important aspects of
the W3C Recommendation of which this is a part.
See below (at the bottom of this document) for information about
the revision and namespace-versioning policy governing this
schema document.
The simpleType element and all of its members are defined
in datatypes.xsd
Get access to the xml: attribute groups for xml:lang
as declared on ''schema'' and ''documentation'' below
This type is extended by almost all schema types
to allow attributes from other namespaces to be
added to user schemas.
This type is extended by all types which allow annotation
other than <schema> itself
This group is for the
elements which occur freely at the top level of schemas.
All of their types are based on the "annotated" type by extension.
This group is for the
elements which can self-redefine (see <redefine> below).
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
#all or (possibly empty) subset of {extension, restriction}
A utility type, not for public use
A utility type, not for public use
#all or (possibly empty) subset of {extension, restriction, list, union}
for maxOccurs
for all particles
for element, group and attributeGroup,
which both define and reference
''complexType'' uses this
This branch is short for
<complexContent>
<restriction base="xs:anyType">
...
</restriction>
</complexContent>
Will be restricted to required or prohibited
Not allowed if simpleContent child is chosen.
May be overridden by setting on complexContent child.
This choice is added simply to
make this a valid restriction per the REC
Overrides any setting on complexType parent.
This choice is added simply to
make this a valid restriction per the REC
No typeDefParticle group reference
A utility type, not for public use
#all or (possibly empty) subset of {substitution, extension,
restriction}
The element element can be used either
at the top level to define an element-type binding globally,
or within a content model to either reference a globally-defined
element or type or declare an element-type binding locally.
The ref form is not allowed at the top level.
This type is used for ''alternative'' elements.
group type for explicit groups, named top-level groups and
group references
group type for the three kinds of group
This choice with min/max is here to
avoid a pblm with the Elt:All/Choice/Seq
Particle derivation constraint
Only elements allowed inside
simple type for the value of the ''namespace'' attr of
''any'' and ''anyAttribute''
Value is
##any - - any non-conflicting WFXML/attribute at all
##other - - any non-conflicting WFXML/attribute from
namespace other than targetNS
##local - - any unqualified non-conflicting WFXML/attribute
one or - - any non-conflicting WFXML/attribute from
more URI the listed namespaces
references
(space separated)
##targetNamespace or ##local may appear in the above list, to
refer to the targetNamespace of the enclosing
schema or an absent targetNamespace respectively
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A utility type, not for public use
A subset of XPath expressions for use
in selectors
A utility type, not for public
use
A subset of XPath expressions for use
in fields
A utility type, not for public
use
The three kinds of identity constraints, all with
type of or derived from ''keybase''.
A utility type, not for public use
A public identifier, per ISO 8879
notations for use within schema documents
Not the real urType, but as close an approximation as we can
get in the XML representation
In keeping with the XML Schema WG''s standard versioning policy,
this schema document will persist at the URI
http://www.w3.org/2009/12/XMLSchema.xsd.
At the date of issue it can also be found at the URI
http://www.w3.org/2009/XMLSchema/XMLSchema.xsd.
The schema document at that URI may however change in the future,
in order to remain compatible with the latest version of XSD
and its namespace. In other words, if XSD or the XML Schema
namespace change, the version of this document at
http://www.w3.org/2009/XMLSchema/XMLSchema.xsd will change accordingly;
the version at http://www.w3.org/2009/12/XMLSchema.xsd will not change.
Previous dated (and unchanging) versions of this schema document
include:
http://www.w3.org/2009/04/XMLSchema.xsd
(XSD 1.1 Candidate Recommendation)
http://www.w3.org/2004/10/XMLSchema.xsd
(XSD 1.0 Recommendation, Second Edition)
http://www.w3.org/2001/05/XMLSchema.xsd
(XSD 1.0 Recommendation, First Edition)
'! !
Object subclass: #PPXmlNode
instanceVariableNames: 'name attributes contents'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
PPXmlNode subclass: #PPXmlComment
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
PPXmlNode subclass: #PPXmlElement
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlElement class methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:38'!
named: aString attributes: aDictionary
^ self basicNew
initializeNamed: aString attributes: aDictionary;
yourself! !
!PPXmlElement methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:39'!
attributes
^ attributes! !
!PPXmlElement methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:38'!
contents
^ contents! !
!PPXmlElement methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:38'!
initializeNamed: aString attributes: aDictionary
name := aString.
attributes := aDictionary! !
!PPXmlElement methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:39'!
name
^ name! !
!PPXmlElement methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:43'!
printXmlOn: aStream
aStream nextPut: $<; nextPutAll: name.
contents isNil
ifTrue: [ aStream nextPutAll: '/>' ]
ifFalse: [
aStream nextPut: $>.
contents do: [ :each | each printXmlOn: aStream ].
aStream nextPutAll: ''; nextPutAll: name; nextPut: $> ]! !
!PPXmlNode methodsFor: 'printing' stamp: 'lr 1/26/2010 16:45'!
printOn: aStream
super printOn: aStream.
aStream nextPutAll: ' '.
self printXmlOn: aStream! !
!PPXmlNode methodsFor: 'printing' stamp: 'lr 1/26/2010 16:45'!
printXmlOn: aStream
self subclassResponsibility! !
PPXmlNode subclass: #PPXmlProcessing
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
PPXmlNode subclass: #PPXmlText
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlText methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 16:50'!
printXmlOn: aStream! !
PPFlattenParser subclass: #PPXmlTokenParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Support'!
!PPXmlTokenParser methodsFor: 'hooks' stamp: 'lr 1/26/2010 11:44'!
create: aCollection start: aStartInteger stop: aStopInteger
^ PPToken on: aCollection start: aStartInteger stop: aStopInteger! !
PPCompositeParser subclass: #PPXmlGrammar
instanceVariableNames: 'comment whitespace processing nameStartChar nameChar nameToken nmToken misc document prolog element attributes content characterData attribute doctype attributeValue'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 14:18'!
attribute
"[41] Attribute ::= Name Eq AttValue"
^ self parserForAttribute: nameToken value: attributeValue! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 14:18'!
attributeValue
^ $" asParser negate star flatten! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 14:13'!
attributes
"[40] STag ::= '<' Name (S Attribute)* S? '>' "
^ ((whitespace , attribute) ==> #second) star ==> [ :nodes |
nodes
inject: Dictionary new
into: [ :dict :each | dict add: each; yourself ] ]! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 12:42'!
characterData
"[14] CharData ::= [^<&]* - ([^<&]* ']]>' [^<&]*)"
^ $< asParser negate plus token! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 12:48'!
comment
"[15] Comment ::= ''"
^ '' asParser not , #any asParser) star , '-->' asParser! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 16:24'!
content
"[43] content ::= CharData? ((element | Reference | CDSect | PI | Comment) CharData?)*"
^ characterData optional , ((element / processing / comment) , characterData optional) star ==> [ :nodes |
| result |
result := OrderedCollection new.
nodes first isNil
ifFalse: [ result addLast: nodes first ].
nodes second do: [ :each |
each notNil
ifTrue: [ result addLast: each ] ].
result ]! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 13:09'!
doctype
"[28] doctypedecl ::= ''"
^ ' asParser! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 13:00'!
document
"[1] document ::= prolog element Misc*"
^ self parserForDocument: prolog element: self parserForRootElement! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 13:30'!
element
"[39] element ::= EmptyElemTag | STag content ETag"
^ (self parserForTag: nameToken attributes: attributes)
/ (self parserForTag: nameToken attributes: attributes content: content)! !
!PPXmlGrammar methodsFor: 'grammar-character' stamp: 'lr 1/26/2010 09:08'!
misc
"[27] Misc ::= Comment | PI | S"
^ (whitespace / comment / processing) star! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 1/26/2010 09:13'!
nameChar
"[4a] NameChar ::= NameStartChar | ""-"" | ""."" | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]"
^ PPPredicateParser on: [ :char | char = $- or: [ char = $. or: [ char = $: or: [ char = $_ or: [ char isAlphaNumeric ] ] ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token-characters' stamp: 'lr 1/26/2010 09:13'!
nameStartChar
"[4] NameStartChar ::= "":"" | [A-Z] | ""_"" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF]"
^ PPPredicateParser on: [ :char | char = $: or: [ char = $_ or: [ char isLetter ] ] ] message: 'name expected'! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:15'!
nameToken
"[5] Name ::= NameStartChar (NameChar)*"
^ (nameStartChar , nameChar star) flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 10:41'!
nameTokens
"[6] Names ::= Name (#x20 Name)*"
^ (nameToken separatedBy: $ asParser) flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:17'!
nmToken
"[7] Nmtoken ::= (NameChar)+"
^ nameChar plus flatten! !
!PPXmlGrammar methodsFor: 'token' stamp: 'lr 1/26/2010 09:17'!
nmTokens
"[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)*"
^ (nmToken separatedBy: $ asParser) flatten! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 14:15'!
parserForAttribute: aNameParser value: aValueParser
"Answer a parser that can read an XML attribute."
^ aNameParser asParser flatten , whitespace optional , $= asParser , whitespace optional , $" asParser , aValueParser asParser , $" asParser
==> [ :nodes | nodes first -> nodes sixth ]! !
!PPXmlGrammar methodsFor: 'parsers-tags' stamp: 'lr 1/26/2010 16:33'!
parserForCloseTag: aNameParser
"Answer a parser that parses an XML element named aNameParser close-tag. This parser answers the name of the tag."
^ '' asParser , aNameParser asParser flatten , whitespace optional , $> asParser
==> #second! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:53'!
parserForDocument: aPrologParser element: anElementParser
"Answer a parser that can read an XML document."
^ aPrologParser asParser , anElementParser asParser , misc
==> [ :nodes | Array with: nodes first with: nodes second ]! !
!PPXmlGrammar methodsFor: 'parsers-tags' stamp: 'lr 1/26/2010 16:51'!
parserForEmptyTag: aNameParser attributes: anAttributeParser
"Answer a parser that parses an XML element named aNameParser with the attributes anAttributeParser (expected to answer a dictionary). This parser answers instances of PPXmlElement."
^ $< asParser , aNameParser asParser flatten , anAttributeParser asParser , whitespace optional , '/>' asParser
==> [ :nodes | PPXmlElement named: nodes second attributes: nodes third ]! !
!PPXmlGrammar methodsFor: 'parsers-tags' stamp: 'lr 1/26/2010 16:51'!
parserForOpenTag: aNameParser attributes: anAttributeParser
"Answer a parser that parses an XML element named aNameParser with the attributes anAttributeParser (expected to answer a dictionary). This parser answers instances of PPXmlElement."
^ $< asParser , aNameParser asParser flatten , anAttributeParser asParser , whitespace optional , $> asParser
==> [ :nodes | PPXmlElement named: aNameParser attributes: nodes third ]! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 11:49'!
parserForProcessingInstruction: aTargetParser
"Answer a parser that can read an XML processing instruction."
^ '' asParser , aTargetParser asParser token , (whitespace , ('?>' asParser not , #any asParser) star token) optional , '?>' asParser
==> [ :nodes | Array with: nodes second with: (nodes third ifNotNil: [ :inner | inner second ]) ]! !
!PPXmlGrammar methodsFor: 'parsers' stamp: 'lr 1/26/2010 13:01'!
parserForRootElement
^ element! !
!PPXmlGrammar methodsFor: 'parsers-tags' stamp: 'lr 1/26/2010 16:34'!
parserForTag: aNameParser attributes: anAttributeParser
"Answer a parser that reads an empty XML tag. This parser answers instances of PPXmlElement."
^ self parserForTag: aNameParser attributes: anAttributeParser content: nil! !
!PPXmlGrammar methodsFor: 'parsers-tags' stamp: 'lr 1/26/2010 16:37'!
parserForTag: aNameParser attributes: anAttributeParser content: aContentParser
"Answer a parser that can read the XML tags."
^ aContentParser isNil
ifTrue: [ self parserForEmptyTag: aNameParser attributes: anAttributeParser ]
ifFalse: [
(self parserForOpenTag: aNameParser attributes: anAttributeParser) , (aContentParser asParser) , [ :stream | stream position ] asParser , (self parserForCloseTag: aNameParser) ==> [ :nodes |
nodes first name = nodes last
ifTrue: [ nodes first contents: nodes second ]
ifFalse: [ PPFailure reason: 'Expected ' , nodes first name , '> but got ' , nodes last , '>' at: nodes third ] ] ]! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 16:21'!
processing
"[16] PI ::= '' PITarget (S (Char* - (Char* '?>' Char*)))? '?>'
[17] PITarget ::= Name - (('X' | 'x') ('M' | 'm') ('L' | 'l'))"
^ self parserForProcessingInstruction: #letter asParser plus! !
!PPXmlGrammar methodsFor: 'grammar' stamp: 'lr 1/26/2010 13:05'!
prolog
"[22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)?"
^ (self parserForProcessingInstruction: 'xml') optional , misc , (doctype , misc) optional
==> [ :nodes | nodes first ]! !
!PPXmlGrammar methodsFor: 'accessing' stamp: 'lr 1/26/2010 09:25'!
start
^ document end! !
!PPXmlGrammar methodsFor: 'accessing' stamp: 'lr 1/26/2010 11:45'!
tokenParser
^ PPXmlTokenParser! !
!PPXmlGrammar methodsFor: 'grammar-misc' stamp: 'lr 1/26/2010 08:46'!
whitespace
"[3] S ::= (#x20 | #x9 | #xD | #xA)+"
^ #space asParser plus! !
PPXmlGrammar subclass: #PPXmlXsdGrammar
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
!PPXmlXsdGrammar methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 13:43'!
parserForRootElement
^ (self parserForOpenTag: nameToken attributes: attributes) and ==> [ :nodes | self halt ]! !
PPCompositeParser subclass: #PPXmlRegistry
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Core'!
TestCase subclass: #PPXmlTest
instanceVariableNames: 'result'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
PPXmlTest subclass: #PPXmlGrammarTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'TestRunner 1/7/2010 14:03'!
parserClass
^ PPXmlGrammar! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 13:10'!
testDoctype
self parse: '
[ ] >
'! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:48'!
testParseAll
self resource allXsdDefinitions
do: [ :each | self parse: each ]! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:55'!
testParseComment
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:56'!
testParseCommentWithXml
self parse: ' -->' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 12:40'!
testParseComplicated
self parse: '
' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:56'!
testParseEmptyElement
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 13:25'!
testParseNamespace
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:48'!
testParseSimple
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 11:00'!
testParseSimpleAttribute
self parse: '' ! !
!PPXmlGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 10:57'!
testParseWithWhitsepaceAfterProlog
self parse: '
' ! !
!PPXmlTest class methodsFor: 'testing' stamp: 'lr 1/26/2010 13:12'!
isAbstract
^ self name = #PPXmlTest! !
!PPXmlTest class methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:40'!
packageNamesUnderTest
^ #('PetitXml')! !
!PPXmlTest class methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:41'!
resources
^ Array with: PPXmlResource! !
!PPXmlTest methodsFor: 'parsing' stamp: 'TestRunner 1/7/2010 14:42'!
parse: aString
self parse: aString rule: #start! !
!PPXmlTest methodsFor: 'parsing' stamp: 'lr 1/7/2010 13:41'!
parse: aString rule: aSymbol
| production |
production := self parser.
aSymbol = #start
ifFalse: [ production := production instVarNamed: aSymbol ].
result := production end
parse: aString asParserStream.
self
deny: result isFailure
description: 'Unable to parse ' , aString printString! !
!PPXmlTest methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:56'!
parser
^ self resource parserAt: self parserClass! !
!PPXmlTest methodsFor: 'accessing' stamp: 'lr 1/7/2010 13:41'!
parserClass
self subclassResponsibility! !
!PPXmlTest methodsFor: 'accessing' stamp: 'TestRunner 1/7/2010 14:03'!
resource
^ PPXmlResource current! !
PPXmlTest subclass: #PPXmlXsdGrammarTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitXml-Tests'!
!PPXmlXsdGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 12:58'!
parserClass
^ PPXmlXsdGrammar! !
!PPXmlXsdGrammarTest methodsFor: 'as yet unclassified' stamp: 'lr 1/26/2010 13:12'!
testParseAll
self resource allXsdDefinitions
do: [ :each | self parse: each ]! !