SystemOrganization addCategory: #'PetitJson-Core'! SystemOrganization addCategory: #'PetitJson-Tests'! PPCompositeParser subclass: #PPJsonGrammar instanceVariableNames: 'members pair string value elements number object array trueToken falseToken nullToken char stringToken numberToken charEscape charNormal charOctal' classVariableNames: 'CharacterTable' poolDictionaries: '' category: 'PetitJson-Core'! !PPJsonGrammar class methodsFor: 'initialization' stamp: 'lr 7/28/2010 09:35'! initialize CharacterTable := Dictionary new. CharacterTable at: $\ put: $\; at: $/ put: $/; at: $" put: $"; at: $b put: Character backspace; at: $f put: Character newPage; at: $n put: Character lf; at: $r put: Character cr; at: $t put: Character tab! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:12'! array ^ $[ asParser token trim , elements optional , $] asParser token trim! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 09:40'! char ^ charEscape / charOctal / charNormal! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 10:14'! charEscape ^ $\ asParser , (PPPredicateObjectParser anyOf: (String withAll: CharacterTable keys))! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 09:59'! charNormal ^ PPPredicateObjectParser anyExceptAnyOf: '\"'! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 09:45'! charOctal ^ '\u' asParser , (#hex asParser min: 4 max: 4)! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:12'! elements ^ value separatedBy: $, asParser token trim! ! !PPJsonGrammar methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:12'! falseToken ^ 'false' asParser token trim! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:12'! members ^ pair separatedBy: $, asParser token trim! ! !PPJsonGrammar methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:12'! nullToken ^ 'null' asParser token trim! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 08:14'! number ^ $- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional , (($e asParser / $E asParser) , ($- asParser / $+ asParser) optional , #digit asParser plus) optional! ! !PPJsonGrammar methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:12'! numberToken ^ number token trim! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:12'! object ^ ${ asParser token trim , members optional , $} asParser token trim! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:19'! pair ^ stringToken , $: asParser token trim , value! ! !PPJsonGrammar methodsFor: 'accessing' stamp: 'lr 7/28/2010 08:17'! start ^ value end! ! !PPJsonGrammar methodsFor: 'primitives' stamp: 'lr 7/28/2010 09:47'! string ^ $" asParser , char star , $" asParser! ! !PPJsonGrammar methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:12'! stringToken ^ string token trim! ! !PPJsonGrammar methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:12'! trueToken ^ 'true' asParser token trim! ! !PPJsonGrammar methodsFor: 'grammar' stamp: 'lr 12/6/2009 13:31'! value ^ stringToken / numberToken / object / array / trueToken / falseToken / nullToken! ! PPJsonGrammar subclass: #PPJsonParser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitJson-Core'! !PPJsonParser methodsFor: 'grammar' stamp: 'lr 12/6/2009 13:29'! array ^ super array ==> [ :nodes | Array withAll: (nodes second ifNil: [ #() ]) ]! ! !PPJsonParser methodsFor: 'primitives' stamp: 'lr 7/28/2010 10:14'! charEscape ^ super charEscape ==> [ :nodes | CharacterTable at: nodes last ]! ! !PPJsonParser methodsFor: 'primitives' stamp: 'lr 7/28/2010 10:15'! charOctal ^ super charOctal ==> [ :nodes | Character value: (nodes last allButFirst inject: nodes last first digitValue into: [ :result :each | (result << 4) + each digitValue ]) ]! ! !PPJsonParser methodsFor: 'grammar' stamp: 'lr 12/6/2009 13:25'! elements ^ super elements ==> [ :nodes | nodes reject: [ :each | each isKindOf: PPToken ] ]! ! !PPJsonParser methodsFor: 'tokens' stamp: 'lr 12/6/2009 12:48'! falseToken ^ super falseToken ==> [ :token | false ]! ! !PPJsonParser methodsFor: 'grammar' stamp: 'lr 12/6/2009 13:26'! members ^ super members ==> [ :nodes | nodes reject: [ :each | each isKindOf: PPToken ] ]! ! !PPJsonParser methodsFor: 'tokens' stamp: 'lr 12/6/2009 12:48'! nullToken ^ super nullToken ==> [ :token | nil ]! ! !PPJsonParser methodsFor: 'tokens' stamp: 'lr 7/28/2010 08:16'! numberToken ^ super numberToken ==> [ :token | (token value copyWithout: $+) asNumber ]! ! !PPJsonParser methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:19'! object ^ super object ==> [ :nodes | (nodes second ifNil: [ #() ]) inject: Dictionary new into: [ :result :each | result add: each; yourself ] ]! ! !PPJsonParser methodsFor: 'grammar' stamp: 'lr 7/28/2010 08:18'! pair ^ super pair map: [ :key :sep :val | key -> val ]! ! !PPJsonParser methodsFor: 'tokens' stamp: 'lr 7/28/2010 10:06'! stringToken ^ string trim ==> [ :nodes | String withAll: nodes second ]! ! !PPJsonParser methodsFor: 'tokens' stamp: 'lr 12/6/2009 12:49'! trueToken ^ super trueToken ==> [ :token | true ]! ! TestCase subclass: #PPJsonGrammarTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'PetitJson-Tests'! !PPJsonGrammarTest class methodsFor: 'accessing' stamp: 'lr 7/28/2010 10:16'! packageNamesUnderTest ^ #('PetitJson')! ! !PPJsonGrammarTest methodsFor: 'utilities' stamp: 'lr 12/6/2009 12:48'! assertInvalid: aString self should: [ self parse: aString ] raise: Error! ! !PPJsonGrammarTest methodsFor: 'utilities' stamp: 'lr 7/28/2010 08:01'! parse: aString ^ PPJsonParser parse: aString onError: [ :pos :msg | self error: msg ]! ! !PPJsonGrammarTest methodsFor: 'testing-array' stamp: 'lr 12/6/2009 12:44'! testBigArray | result | result := self parse: ' [ "a" , "b" ] '. self assert: result isArray. self assert: result size = 2. self assert: result first = 'a'. self assert: result second = 'b'.! ! !PPJsonGrammarTest methodsFor: 'testing-objects' stamp: 'lr 12/6/2009 12:44'! testBigObject | result | result := self parse: ' { "a" : 1 , "b" : 2 } '. self assert: result isDictionary. self assert: result size = 2. self assert: (result at: 'a') = 1. self assert: (result at: 'b') = 2.! ! !PPJsonGrammarTest methodsFor: 'testing-array' stamp: 'lr 12/6/2009 12:44'! testEmptyArray | result | result := self parse: '[]'. self assert: result isArray. self assert: result isEmpty! ! !PPJsonGrammarTest methodsFor: 'testing-objects' stamp: 'lr 12/6/2009 12:44'! testEmptyObject | result | result := self parse: '{}'. self assert: result isDictionary. self assert: result isEmpty! ! !PPJsonGrammarTest methodsFor: 'testing-real' stamp: 'lr 12/6/2009 12:44'! testExplorerEvent | result | result := self parse: '{"recordset": null, "type": "change", "fromElement": null, "toElement": null, "altLeft": false, "keyCode": 0, "repeat": false, "reason": 0, "behaviorCookie": 0, "contentOverflow": false, "behaviorPart": 0, "dataTransfer": null, "ctrlKey": false, "shiftLeft": false, "dataFld": "", "qualifier": "", "wheelDelta": 0, "bookmarks": null, "button": 0, "srcFilter": null, "nextPage": "", "cancelBubble": false, "x": 89, "y": 502, "screenX": 231, "screenY": 1694, "srcUrn": "", "boundElements": {"length": 0}, "clientX": 89, "clientY": 502, "propertyName": "", "shiftKey": false, "ctrlLeft": false, "offsetX": 25, "offsetY": 2, "altKey": false}'. self assert: (result at: 'type') = 'change'. self assert: (result at: 'offsetY') = 2. self deny: (result at: 'altKey'). self assert: (result at: 'dataTransfer') isNil. self assert: (result at: 'nextPage') = ''! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 12/6/2009 12:44'! testFalse self deny: (self parse: 'false')! ! !PPJsonGrammarTest methodsFor: 'testing-real' stamp: 'lr 12/6/2009 12:44'! testFirefoxEvent | result | result := self parse: '{"type": "change", "eventPhase": 2, "bubbles": true, "cancelable": true, "timeStamp": 0, "CAPTURING_PHASE": 1, "AT_TARGET": 2, "BUBBLING_PHASE": 3, "isTrusted": true, "MOUSEDOWN": 1, "MOUSEUP": 2, "MOUSEOVER": 4, "MOUSEOUT": 8, "MOUSEMOVE": 16, "MOUSEDRAG": 32, "CLICK": 64, "DBLCLICK": 128, "KEYDOWN": 256, "KEYUP": 512, "KEYPRESS": 1024, "DRAGDROP": 2048, "FOCUS": 4096, "BLUR": 8192, "SELECT": 16384, "CHANGE": 32768, "RESET": 65536, "SUBMIT": 131072, "SCROLL": 262144, "LOAD": 524288, "UNLOAD": 1048576, "XFER_DONE": 2097152, "ABORT": 4194304, "ERROR": 8388608, "LOCATE": 16777216, "MOVE": 33554432, "RESIZE": 67108864, "FORWARD": 134217728, "HELP": 268435456, "BACK": 536870912, "TEXT": 1073741824, "ALT_MASK": 1, "CONTROL_MASK": 2, "SHIFT_MASK": 4, "META_MASK": 8}'. self assert: (result at: 'type') = 'change'. self assert: (result at: 'eventPhase') = 2. self assert: (result at: 'bubbles'). self assert: (result at: 'cancelable'). self assert: (result at: 'BACK') = 536870912! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidArray self assertInvalid: '['. self assertInvalid: '[1'. self assertInvalid: '[1,'. self assertInvalid: '[1,]'. self assertInvalid: '[1 2]'. self assertInvalid: '[]]'! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidFalse self assertInvalid: 'fa'. self assertInvalid: 'falsely'. self assertInvalid: 'fabulous'! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidNull self assertInvalid: 'nu'. self assertInvalid: 'nuclear'. self assertInvalid: 'nullified'! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidObject self assertInvalid: '{'. self assertInvalid: '{"a"'. self assertInvalid: '{"a":'. self assertInvalid: '{"a":"b"'. self assertInvalid: '{"a":"b",'. self assertInvalid: '{"a"}'. self assertInvalid: '{"a":}'. self assertInvalid: '{"a":"b",}'. self assertInvalid: '{}}'! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidString self assertInvalid: '"'. self assertInvalid: '"a'. self assertInvalid: '"\"'. self assertInvalid: '"\a"'. self assertInvalid: '"\u"'. self assertInvalid: '"\u1"'. self assertInvalid: '"\u12"'. self assertInvalid: '"\u123"'. self assertInvalid: '"\u123x"'! ! !PPJsonGrammarTest methodsFor: 'testing-invalid' stamp: 'lr 12/6/2009 12:44'! testInvalidTrue self assertInvalid: 'tr'. self assertInvalid: 'trace'. self assertInvalid: 'truest'! ! !PPJsonGrammarTest methodsFor: 'testing-array' stamp: 'lr 12/6/2009 12:44'! testNestedArray | result | result := self parse: '[[2]]'. self assert: result isArray. self assert: result size = 1. result := result first. self assert: result isArray. self assert: result size = 1. self assert: result first = 2.! ! !PPJsonGrammarTest methodsFor: 'testing-objects' stamp: 'lr 12/6/2009 12:44'! testNestedObject | result | result := self parse: '{"object":{"1":"2"}} '. self assert: result isDictionary. self assert: result size = 1. result := result at: 'object'. self assert: result isDictionary. self assert: result size = 1. self assert: (result at: '1') = '2'.! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 12/6/2009 12:44'! testNull self assert: (self parse: 'null') isNil! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'TestRunner 12/6/2009 13:33'! testNumberFloat self assert: (self parse: '0.0') = 0.0. self assert: (self parse: '0.12') = 0.12. self assert: (self parse: '-0.12') = -0.12. self assert: (self parse: '12.34') = 12.34. self assert: (self parse: '-12.34') = -12.34. self assert: (self parse: '1.2e0') = 1.2. self assert: (self parse: '1.2e-1') = 1.2e-1! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 7/28/2010 08:14'! testNumberInteger self assert: (self parse: '0') = 0. self assert: (self parse: '1') = 1. self assert: (self parse: '-1') = -1. self assert: (self parse: '12') = 12. self assert: (self parse: '-12') = -12. self assert: (self parse: '1e2') = 100. self assert: (self parse: '1e+2') = 100! ! !PPJsonGrammarTest methodsFor: 'testing-real' stamp: 'lr 12/6/2009 12:44'! testSafariEvent | result | result := self parse: '{"returnValue": true, "timeStamp": 1226697417289, "eventPhase": 2, "type": "change", "cancelable": false, "bubbles": true, "cancelBubble": false, "MOUSEOUT": 8, "FOCUS": 4096, "CHANGE": 32768, "MOUSEMOVE": 16, "AT_TARGET": 2, "SELECT": 16384, "BLUR": 8192, "KEYUP": 512, "MOUSEDOWN": 1, "MOUSEDRAG": 32, "BUBBLING_PHASE": 3, "MOUSEUP": 2, "CAPTURING_PHASE": 1, "MOUSEOVER": 4, "CLICK": 64, "DBLCLICK": 128, "KEYDOWN": 256, "KEYPRESS": 1024, "DRAGDROP": 2048}'. self assert: (result at: 'type') = 'change'. self assert: (result at: 'eventPhase') = 2. self assert: (result at: 'bubbles'). self deny: (result at: 'cancelBubble'). self deny: (result at: 'cancelable'). self assert: (result at: 'BLUR') = 8192! ! !PPJsonGrammarTest methodsFor: 'testing-array' stamp: 'lr 12/6/2009 12:44'! testSmallArray | result | result := self parse: '["a"]'. self assert: result isArray. self assert: result size = 1. self assert: result first = 'a'.! ! !PPJsonGrammarTest methodsFor: 'testing-objects' stamp: 'lr 12/6/2009 12:44'! testSmallObject | result | result := self parse: '{"a":1}'. self assert: result isDictionary. self assert: result size = 1. self assert: (result at: 'a') = 1! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 7/28/2010 08:13'! testString self assert: (self parse: '""') = ''. self assert: (self parse: '"foo"') = 'foo'. self assert: (self parse: '"foo bar"') = 'foo bar'! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 7/28/2010 09:52'! testStringEscaped self assert: (self parse: '"\""') = '"'. self assert: (self parse: '"\\"') = '\'. self assert: (self parse: '"\/"') = '/'. self assert: (self parse: '"\b"') = (String with: Character backspace). self assert: (self parse: '"\f"') = (String with: Character newPage). self assert: (self parse: '"\n"') = (String with: Character lf). self assert: (self parse: '"\r"') = (String with: Character cr). self assert: (self parse: '"\t"') = (String with: Character tab). self assert: (self parse: '"\u20Ac"') = (String with: (Character codePoint: 16r20AC))! ! !PPJsonGrammarTest methodsFor: 'testing-literals' stamp: 'lr 12/6/2009 12:44'! testTrue self assert: (self parse: 'true')! ! PPJsonGrammar initialize!