1 "{ Package: 'stx:goodies/ston/tests' }"

     2 

     3 "{ NameSpace: Smalltalk }"

     4 

     5 TestCase subclass:#STONReaderTests

     6 	instanceVariableNames:''

     7 	classVariableNames:''

     8 	poolDictionaries:''

     9 	category:'STON-Tests-Reader'

    10 !

    11 

    12 

    13 !STONReaderTests methodsFor:'private'!

    14 

    15 materialize: string

    16 	^ STON reader 

    17 		on: string readStream;

    18 		next

    19 ! !

    20 

    21 !STONReaderTests methodsFor:'tests'!

    22 

    23 testAssociation

    24 	self assert: (self materialize: '''foo'':1') = ('foo' -> 1).

    25 	self assert: (self materialize: '#bar:2') = (#bar -> 2).

    26 	self assert: (self materialize: '''foo bar'':#ok') = ('foo bar' -> #ok).

    27 	self assert: (self materialize: '123:456') = (123 -> 456).

    28 	

    29 	self assert: (self materialize: '''foo'' : 1') = ('foo' -> 1).

    30 	self assert: (self materialize: '#bar : 2') = (#bar -> 2).

    31 	self assert: (self materialize: '''foo bar'' : #ok') = ('foo bar' -> #ok).

    32 	self assert: (self materialize: '123 : -456') = (123 -> -456).

    33 	

    34 	self assert: (self materialize: '#foo : 1 : 2') = (#foo -> (1 -> 2))

    35 !

    36 

    37 testBag

    38 	self 

    39 		assert: (self materialize: 'Bag{#a:2,#b:3}') 

    40 		equals: (Bag withAll: #(a a b b b)).

    41 	self 

    42 		assert: (self materialize: 'Bag{}') 

    43 		equals: Bag new.

    44 !

    45 

    46 testBoolean

    47 	self assert: (self materialize: 'true') equals: true.

    48 	self assert: (self materialize: 'false') equals: false

    49 !

    50 

    51 testByteArray

    52 	self assert: (self materialize: 'ByteArray[''010203'']') = #(1 2 3) asByteArray

    53 !

    54 

    55 testCharacter

    56 	self assert: (self materialize: 'Character[''A'']') == $A.

    57 !

    58 

    59 testClass

    60 	self assert: (self materialize: 'Class[#Point]') equals: Point

    61 !

    62 

    63 testClassWithUnderscore

    64 

    65         | cls data reader |

    66 

    67         cls := Class new.

    68         cls setName: #A_B_C123AnonClass.

    69 

    70         data := STON toString: cls new.

    71         reader := STONReader on: data readStream.

    72 

    73         (reader instVarNamed: #classes) 

    74                 at: cls name 

    75                 put: cls.

    76 

    77         self assert: reader next class equals: cls

    78 

    79     "Modified: / 20-05-2020 / 12:24:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    80 !

    81 

    82 testColor

    83         self 

    84                 assert: (self materialize: 'Color[#red]')

    85                 equals: Color red.

    86         self 

    87                 assert: (self materialize: 'Color{#red:1.0,#green:0.0,#blue:0.0,#alpha:0.4}')

    88                 equals: (Color red copy alpha: 0.4).

    89         self 

    90                 assert: (self materialize: 'Color{#red:1.0,#green:0.79339284351873047,#blue:0.79339284351873047,#alpha:1.0}')

    91                 equals: Color red lighter lighter.

    92 

    93     "Modified: / 20-05-2020 / 12:23:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    94 !

    95 

    96 testConvertingNewLines

    97         | input result output |

    98         input := '''line ending with CR', String return, 

    99                 'line ending with LF', String lf, 

   100                 'line ending with CRLF', String crlf, ''''.

   101         output := 'line ending with CR', String crlf, 

   102                 'line ending with LF', String crlf, 

   103                 'line ending with CRLF', String crlf.

   104         result := (STON reader on: input readStream) newLine: String crlf; convertNewLines: true; next.

   105         self assert: result equals: output.

   106         output := 'line ending with CR', String return, 

   107                 'line ending with LF', String return, 

   108                 'line ending with CRLF', String return.

   109         result := (STON reader on: input readStream) newLine: String return; convertNewLines: true; next.

   110         self assert: result equals: output

   111 

   112     "Modified: / 04-06-2019 / 10:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   113 !

   114 

   115 testDate

   116 	| date |

   117 	date := (Date year: 2012 month: 1 day: 1) translateToUTC.

   118 	self assert: (self materialize: 'Date[''2012-01-01Z'']') equals: date.

   119 	self assert: (self materialize: 'Date[''2012-01-01+00:00'']') equals: date.

   120 	date := (Date year: 2012 month: 1 day: 1) translateTo: 1 hour.

   121 	self assert: (self materialize: 'Date[''2012-01-01+01:00'']') equals: date.

   122 	"a missing timezone offset results in the local timezone offset being used,

   123 	this is never written by STON, but matches the first implementation for backwards compatibility"

   124 	date := Date year: 2012 month: 1 day: 1.

   125 	self assert: (self materialize: 'Date[''2012-01-01'']') equals: date.

   126 !

   127 

   128 testDateAndTime

   129 	| dateAndTime |

   130 	dateAndTime := DateAndTime year: 2012 month: 1 day: 1 hour: 6 minute: 30 second: 15 offset: 1 hour.

   131 	self assert: (self materialize: 'DateAndTime[''2012-01-01T06:30:15+01:00'']') = dateAndTime

   132 !

   133 

   134 testDeepStructure

   135         | holder deepest structure writer ston reader result |

   136 

   137         self skip: 'Uses too much stack for stock St/X settings'.

   138 

   139         "Create a deep nested structure so that the deepest element is a reference back to a top level holder."

   140         holder := Array with: 42.

   141         deepest := Array with: holder.

   142         structure := deepest.

   143         1 * 1024 timesRepeat: [ structure := Array with: structure ].

   144         structure := Array with: holder with: structure.

   145         writer := STON writer optimizeForLargeStructures.

   146         ston := String streamContents: [ :out | (writer on: out) nextPut: structure ].

   147         "After reading, the second pass will have to go down the structure to resolve the reference."

   148         reader := STON reader optimizeForLargeStructures.

   149         result := (reader on: ston readStream) next.

   150         self assert: result equals: structure

   151 

   152     "Modified: / 20-05-2020 / 11:30:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   153 !

   154 

   155 testDictionary

   156 	| collection |

   157 	collection := STON mapClass new at: 1 put: 1; at: 2 put: 2; yourself.

   158 	self assert: (self materialize: '{1:1,2:2}') = collection.

   159 	self assert: (self materialize: '{}') = STON mapClass new.

   160 !

   161 

   162 testDictionaryWithComplexKeys

   163 	| collection reader |

   164 	collection := STON mapClass new at: true put: 1; at: #(foo) put: 2; yourself.

   165 	"allowing complex map keys used to be optional, now it is always the default"

   166 	reader := STONReader on: '{true:1,[#foo]:2}' readStream.

   167 	self assert: reader next = collection

   168 !

   169 

   170 testDictionaryWithIndirectReferenceKeys

   171 	| keysCollection dictionary ston object |

   172 	keysCollection := OrderedCollection streamContents: [ :out |

   173 		10 timesRepeat: [ out nextPut: UUID new ] ].

   174 	dictionary := Dictionary new.

   175 	keysCollection doWithIndex: [ :each :index | 

   176 		dictionary at: (Array with: each) put: index ].

   177 	object := Array with: keysCollection with: dictionary.

   178 	ston := STON toStringPretty: object.

   179 	object := (STON reader on: ston readStream) next.

   180 	object first doWithIndex: [ :each :index |

   181 		self assert: (object second at: (Array with: each)) equals: index ].

   182 	self assert: object second isHealthy 

   183 !

   184 

   185 testDictionaryWithReferenceKeys

   186 	| keysCollection dictionary ston object |

   187 	keysCollection := OrderedCollection streamContents: [ :out |

   188 		10 timesRepeat: [ out nextPut: UUID new ] ].

   189 	dictionary := Dictionary new.

   190 	keysCollection doWithIndex: [ :each :index | 

   191 		dictionary at: each put: index ].

   192 	object := Array with: keysCollection with: dictionary.

   193 	ston := STON toStringPretty: object.

   194 	object := (STON reader on: ston readStream) next.

   195 	object first doWithIndex: [ :each :index |

   196 		self assert: (object second at: each) equals: index ].

   197 	self assert: object second isHealthy 

   198 !

   199 

   200 testDiskFile

   201         self assert: (self materialize: 'FILE[''foo.txt'']') equals: 'foo.txt' asFilename.

   202         self assert: (self materialize: 'FILE[''/tmp/foo.txt'']') equals: '/tmp/foo.txt' asFilename.

   203         self assert: (self materialize: 'FILE[''tmp/foo.txt'']') equals: 'tmp/foo.txt' asFilename.

   204         self assert: (self materialize: 'FILE[''/tmp'']') equals: '/tmp' asFilename.

   205 

   206     "Modified: / 20-05-2020 / 12:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   207 !

   208 

   209 testError

   210 	#( 'foo' '{foo:}' '{foo,}' '[1,]' '+1' ']' '#' '' '  ' '	' 'nul' 'tru' 'fals' ) do: [ :each |

   211 		self 

   212 			should: [ self materialize: each ] 

   213 			raise: STONReaderError ]

   214 !

   215 

   216 testFloat

   217 	self assert: ((self materialize: '1.5') closeTo: 1.5).

   218 	self assert: ((self materialize: '-1.5') closeTo: -1.5).

   219 	self assert: (self materialize: '0.0') isZero.

   220 	self assert: (Float pi closeTo: (self materialize: '3.14149')).

   221 	self assert: (1/3 closeTo: (self materialize: '0.333333')).

   222 	self assert: ((self materialize: '1.0e100') closeTo: (10 raisedTo: 100)).

   223 	self assert: ((self materialize: '1.0e-100') closeTo: (10 raisedTo: -100)).

   224 	self assert: ((self materialize: '-1.0e-100') closeTo: (10 raisedTo: -100) negated)

   225 !

   226 

   227 testFraction

   228 	self assert: (self materialize: '1/3') equals: 1/3.

   229 	self assert: (self materialize: '-1/3') equals: -1/3.

   230 	self assert: (self materialize: '100/11') equals: 100/11.

   231 !

   232 

   233 testIdentityDictionary

   234 	| collection |

   235 	collection := IdentityDictionary new at: 1 put: 1; at: 2 put: 2; yourself.

   236 	self assert: (self materialize: 'IdentityDictionary{1:1,2:2}') = collection.

   237 	self assert: (self materialize: 'IdentityDictionary{}') = IdentityDictionary new.

   238 !

   239 

   240 testIllegalCharacterEscapes

   241 	self should: [ STON fromString: '''\a''' ] raise: STONReaderError.

   242 	self should: [ STON fromString: '''\u''' ] raise: STONReaderError.

   243 	self should: [ STON fromString: '''\u00''' ] raise: STONReaderError.

   244 	self should: [ STON fromString: '''\u000''' ] raise: STONReaderError.

   245 	self should: [ STON fromString: '''\*''' ] raise: STONReaderError

   246 !

   247 

   248 testInteger

   249 	self assert: (self materialize: '1') = 1.

   250 	self assert: (self materialize: '-1') = -1.

   251 	self assert: (self materialize: '0') = 0.

   252 	self assert: (self materialize: '1234567890') = 1234567890.

   253 	self assert: (self materialize: '-1234567890') = -1234567890

   254 !

   255 

   256 testList

   257 	self assert: STON listClass = Array.

   258 	self assert: (self materialize: '[1,2,3]') = (STON listClass with: 1 with: 2 with: 3).

   259 	self assert: (self materialize: '[]') = STON listClass new

   260 !

   261 

   262 testMap

   263 	self assert: (self materialize: '{#foo:1}') = (STON mapClass new at: #foo put: 1; yourself).

   264 	self assert: (self materialize: '{}') = STON mapClass new

   265 !

   266 

   267 testMetaclass

   268 	self assert: (self materialize: 'Metaclass[#Point]') equals: Point class

   269 !

   270 

   271 testMimeType

   272         self skip: 'No ZnMimeType in St/X'.

   273 

   274 "/        self 

   275 "/                assert: (self materialize: 'MimeType[''application/json'']') 

   276 "/                equals: ZnMimeType applicationJson.

   277 "/        self 

   278 "/                assert: (self materialize: 'MimeType[''text/plain;charset=utf-8'']') 

   279 "/                equals: ZnMimeType textPlain.

   280 

   281     "Modified: / 20-05-2020 / 12:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   282 !

   283 

   284 testMultiple

   285 	| reader |

   286 	reader := STON reader 

   287 		on: '123 -123 nil #foo true [ 0 ] false { #one : 1 }' readStream.

   288 	self deny: reader atEnd.

   289 	self assert: reader next equals: 123. 

   290 	self assert: reader next equals: -123. 

   291 	self assert: reader next equals: nil. 

   292 	self assert: reader next equals: #foo. 

   293 	self assert: reader next equals: true. 

   294 	self assert: reader next equals: { 0 }. 

   295 	self assert: reader next equals: false. 

   296 	self assert: reader next equals: (Dictionary with: #one -> 1). 

   297 	self assert: reader atEnd.

   298 !

   299 

   300 testNewSymbol

   301 	| n notASymbol shouldBeSymbol |

   302 	

   303 	"Find a name that has not yet been interned"

   304 	n := 0.

   305 	[ Symbol hasInterned: (notASymbol := 'notASymbol', n printString) ifTrue: [ :symbol | symbol ] ] 

   306 		whileTrue: [ n := n + 1 ].

   307 	"Parsing the new, not yet interned name should create a new Symbol"

   308 	shouldBeSymbol := self materialize: '#', notASymbol.

   309 	self assert: (shouldBeSymbol isSymbol and: [ notASymbol = shouldBeSymbol asString ])

   310 !

   311 

   312 testNil

   313 	self assert: (self materialize: 'nil') isNil

   314 !

   315 

   316 testNonBMPCharacterDecoding

   317         "Characters not in the Basic Multilingual Plane are encoded as a UTF-16 surrogate pair"

   318 

   319         | string object |

   320         string := 16r1D11E asCharacter asString. "MUSICAL SYMBOL G CLEF"

   321         object := (STON fromString: '''\uD834\uDD1E''').

   322         self assert: object equals: string

   323 

   324     "Modified: / 20-05-2020 / 12:05:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   325 !

   326 

   327 testNull

   328 	self assert: (self materialize: 'null') isNil

   329 !

   330 

   331 testObject

   332 	self assert: (self materialize: 'Point[1,2]') = (1@2).

   333 	self assert: (self materialize: 'Point[1.5,-0.5]') = (1.5 @ -0.5).

   334 !

   335 

   336 testOrderedCollection

   337 	| collection |

   338 	collection := OrderedCollection with: 1 with: 2 with: 3.

   339 	self assert: (self materialize: 'OrderedCollection[1,2,3]') = collection.

   340 	self assert: (self materialize: 'OrderedCollection[]') = OrderedCollection new.

   341 !

   342 

   343 testPoint

   344 	self assert: (self materialize: 'Point[1,2]') = (1@2)

   345 !

   346 

   347 testReferenceCycle

   348 	| array |

   349 	array := (self materialize: '[1,@1]').

   350 	self assert: array class = STON listClass.

   351 	self assert: array size = 2.

   352 	self assert: array first = 1.

   353 	self assert: array second == array

   354 !

   355 

   356 testReferenceSharing

   357 	| one array |

   358 	one := { #one }.

   359 	array := (self materialize: '[[#one],@2,@2]').

   360 	self assert: array = (STON listClass with: one with: one with: one).

   361 	self assert: array first == array second.

   362 	self assert: array first == array third

   363 !

   364 

   365 testScaledDecimal

   366         self skip.

   367 

   368         self assert: (self materialize: '1/3s2') equals: 1/3s2.

   369         self assert: (self materialize: '-1/3s2') equals: -1/3s2.

   370         self assert: (self materialize: '1/3s10') equals: 1/3s10.

   371         self assert: (self materialize: '-1/3s10') equals: -1/3s10.

   372 

   373     "Modified: / 20-05-2020 / 12:03:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   374 !

   375 

   376 testSetWithIndirectReferenceElements

   377 	| elementsCollection set ston object |

   378 	elementsCollection := OrderedCollection streamContents: [ :out |

   379 		10 timesRepeat: [ out nextPut: UUID new ] ].

   380 	set := Set withAll: (elementsCollection collect: [ :each | Array with: each ]).

   381 	object := Array with: elementsCollection with: set.

   382 	ston := STON toStringPretty: object.

   383 	object := STON fromString: ston readStream.

   384 	object first do: [ :each |

   385 		self assert: (object second includes: (Array with: each)) ].

   386 	self assert: object second isHealthy 

   387 !

   388 

   389 testSetWithReferenceElements

   390 	| elementsCollection set ston object |

   391 	elementsCollection := OrderedCollection streamContents: [ :out |

   392 		10 timesRepeat: [ out nextPut: UUID new ] ].

   393 	set := Set withAll: elementsCollection.

   394 	object := Array with: elementsCollection with: set.

   395 	ston := STON toStringPretty: object.

   396 	object := STON fromString: ston readStream.

   397 	object first do: [ :each |

   398 		self assert: (object second includes: each) ].

   399 	self assert: object second isHealthy 

   400 !

   401 

   402 testStreaming

   403 	| reader |

   404 	reader := STON reader 

   405 		on: '1 2 3 4 5 6 7 8 9 10' readStream.

   406 	self 

   407 		assert: (Array streamContents: [ :stream |

   408 			[ reader atEnd] whileFalse: [ 

   409 				stream nextPut: reader next ] ]) sum

   410 		equals: #(1 2 3 4 5 6 7 8 9 10) sum

   411 !

   412 

   413 testString

   414         | string |

   415         self assert: (self materialize: '''foo''') = 'foo'.

   416         self assert: (self materialize: '''FOO''') = 'FOO'.

   417         self assert: (self materialize: '''\u00E9l\u00E8ve en Fran\u00E7ais''') = #[195 169 108 195 168 118 101 32 101 110 32 70 114 97 110 195 167 97 105 115] utf8Decoded .

   418         string := String withAll: { 

   419                 $". $'. $\. $/. Character tab. Character cr. Character lf.  Character newPage. Character backspace }.

   420         self assert: (self materialize: '''\"\''\\\/\t\r\n\f\b''') = string.

   421 

   422     "Modified: / 20-05-2020 / 12:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   423 !

   424 

   425 testSymbol

   426 	self assert: (self materialize: '#''foo''') = #foo.

   427 	self assert: (self materialize: '#foo') = #foo

   428 !

   429 

   430 testTime

   431         | time |

   432         time := Time hour: 6 minute: 30 second: 15.

   433         self assert: (self materialize: 'Time[''06:30:15'']') equals: time.

   434         time := Time hours: 6 minutes: 30 seconds: 15 milliseconds: 123.

   435         self assert: (self materialize: 'Time[''06:30:15.123'']') equals: time.

   436 

   437     "Modified: / 20-05-2020 / 12:01:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   438 !

   439 

   440 testURL

   441 	self 

   442 		assert: (self materialize: 'URL[''https://pharo.org/files/pharo.png'']') 

   443 		equals: 'https://pharo.org/files/pharo.png' asUrl.

   444 	self 

   445 		assert: (self materialize: 'URL[''mailto:sven@stfx.eu'']') 

   446 		equals: 'mailto:sven@stfx.eu' asUrl.

   447 	self 

   448 		assert: (self materialize: 'URL[''file:///var/log/system.log'']') 

   449 		equals: 'file:///var/log/system.log' asUrl.

   450 	self 

   451 		assert: (self materialize: 'URL[''scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag'']') 

   452 		equals: 'scheme://user:password@host:123/var/log/system.log?foo=1&bar#frag' asUrl.

   453 !

   454 

   455 testUnknownClasses

   456 	| input object |

   457 	input := 'FooBar { #foo : 1, #bar : true }'.

   458 	self should: [ self materialize: input ] raise: STONReaderError.

   459 	object := STON reader 

   460 		acceptUnknownClasses: true; 

   461 		on: input readStream; 

   462 		next.

   463 	self assert: object class equals: STON mapClass.

   464 	self assert: (object at: #foo) equals: 1.

   465 	self assert: (object at: #bar).

   466 	self assert: (object at: STON classNameKey) equals: #FooBar

   467 !

   468 

   469 testUser

   470 	| user |

   471 	(user := STONTestUser new)

   472 		username: 'john@foo.com';

   473 		password: 'secret1'.

   474 	self assert: (self materialize: 'STONTestUser{#username:''john@foo.com'',#password:''secret1'',#enabled:true}') = user

   475 !

   476 

   477 testUser2

   478 	| user |

   479 	(user := STONTestUser2 new)

   480 		username: 'john@foo.com';

   481 		password: 'secret1'.

   482 	self assert: (self materialize: 'STONTestUser2{#username:''john@foo.com'',#password:''secret1'',#enabled:true}') = user

   483 !

   484 

   485 testWhitespace

   486 	| whitespace |

   487 	whitespace := { Character space. Character tab. Character cr. Character lf }.

   488 	self assert: (self materialize: whitespace, '123') = 123

   489 	

   490 ! !

   491 

   492 !STONReaderTests class methodsFor:'documentation'!

   493 

   494 version_HG

   495 

   496     ^ '$Changeset: <not expanded> $'

   497 ! !

   498