-
Notifications
You must be signed in to change notification settings - Fork 2
Expand file tree
/
Copy pathmsgpack.test
More file actions
704 lines (578 loc) · 23.5 KB
/
msgpack.test
File metadata and controls
704 lines (578 loc) · 23.5 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
lappend auto_path .
package require tcltest
package require msgpack
::tcltest::configure {*}$argv
try {
package require yaml
set mtsPath [file join [file dirname [info script]] \
vendor \
msgpack-test-suite]
} on ok _ {
tcltest::testConstraint yaml true
}
proc flatmap args {
concat {*}[uplevel 1 lmap $args]
}
proc test_map n {
# Get keys and values
set l {}
for {set i 0} {$i < $n} {incr i} {
set m 0
for {set j 0} {$j < 256} {incr j} {
incr m
set k [expr {int(sin($i + $j)*10000000)}]
if {![info exists a($k)]} {
break
}
}
set v [expr {int(sin($n)*100000)}]
lappend l $k $v
set a($k) $v
}
set l [lsort -stride 2 -index 0 -dictionary $l]
# Test with map and loop over elements
set tt [msgpack pack map $n]
foreach {k v} $l {
append tt [msgpack pack int $k]
append tt [msgpack pack int $v]
}
append tt [msgpack pack true]
# Test dict
set tt2 [msgpack pack dict int int $l]
append tt2 [msgpack pack true]
# Test tcl_array
set tt3 [msgpack pack tcl_array int int a]
append tt3 [msgpack pack true]
return [list \
[string equal $tt $tt2] \
[string equal $tt $tt3] \
$tt \
]
}
tcltest::test fix_int8 fix_int8 -body {
set tt [msgpack pack fix_int8 100]
append tt [msgpack pack fix_int8 -100]
append tt [msgpack pack fix_uint8 100]
} -result [binary decode hex d064d09ccc64]
tcltest::test fix_int16 fix_int16 -body {
set tt [msgpack pack fix_int16 1000]
append tt [msgpack pack fix_int16 -1000]
append tt [msgpack pack fix_uint16 1000]
} -result [binary decode hex d103e8d1fc18cd03e8]
tcltest::test fix_int32 fix_int32 -body {
set tt [msgpack pack fix_int32 100000]
append tt [msgpack pack fix_int32 -100000]
append tt [msgpack pack fix_uint32 100000]
} -result [binary decode hex d2000186a0d2fffe7960ce000186a0]
tcltest::test fix_int64 fix_int64 -body {
set tt [msgpack pack fix_int64 1000000000000000]
append tt [msgpack pack fix_int64 -1000000000000000]
append tt [msgpack pack fix_uint64 1000000000000000]
} -result [binary decode hex \
d300038d7ea4c68000d3fffc72815b398000cf00038d7ea4c68000 \
]
tcltest::test nil-true-false nil-true-false -body {
set tt [msgpack pack nil]
append tt [msgpack pack true]
append tt [msgpack pack false]
} -result [binary decode hex c0c3c2]
tcltest::test fixnum-pos-neg fixnum-pos-neg -body {
set tt [msgpack pack fixnumpos 5]
append tt [msgpack pack fixnumpos 50]
append tt [msgpack pack fixnumneg -10]
append tt [msgpack pack fixnumneg -32]
msgpack unpack $tt
} -result {{integer 5} {integer 50} {integer -10} {integer -32}}
tcltest::test int8 int8 -body {
flatmap v {127 128 1 0 -1 -32 -33 -127 -128} {
msgpack pack int8 $v
}
} -result "\x7f \xd0\x80 \x01 \x00 \xff \xe0 \xd0\xdf \xd0\x81 \xd0\x80"
tcltest::test uint8 uint8 -body {
flatmap v {127 128 1 0 -1 -32 -33 -127 -128} {
msgpack pack uint8 $v
}
} -result "\x7f \xcc\x80 \x01 \x00 \xcc\xff \xcc\xe0 \xcc\xdf \xcc\x81\
\xcc\x80"
tcltest::test int16 int16 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 10000 -10000
} {
binary encode hex [msgpack pack int16 $v]
}
} -result {01 00 ff 20 21 e0 d0df 7f cc80 d081 d080 cd0100 cd0101 d1ff01\
d1ff00 cd2710 d1d8f0}
tcltest::test uint16 uint16 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 10000 -10000
} {
binary encode hex [msgpack pack uint16 $v]
}
} -result {01 00 cdffff 20 21 cdffe0 cdffdf 7f cc80 cdff81 cdff80 cd0100\
cd0101 cdff01 cdff00 cd2710 cdd8f0}
tcltest::test int32 int32 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 32767 32768
-32767 -32768 65535 65536 -65535 -65536 10000000 -10000000
} {
binary encode hex [msgpack pack int32 $v]
}
} -result {01 00 ff 20 21 e0 d0df 7f cc80 d081 d080 cd0100 cd0101 d1ff01\
d1ff00 cd7fff cd8000 d18001 d18000 cdffff ce00010000 d2ffff0001\
d2ffff0000 ce00989680 d2ff676980}
tcltest::test uint32 uint32 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 32767 32768
-32767 -32768 65535 65536 -65535 -65536 10000000 -10000000
} {
binary encode hex [msgpack pack uint32 $v]
}
} -result {01 00 ceffffffff 20 21 ceffffffe0 ceffffffdf 7f cc80 ceffffff81\
ceffffff80 cd0100 cd0101 ceffffff01 ceffffff00 cd7fff cd8000\
ceffff8001 ceffff8000 cdffff ce00010000 ceffff0001 ceffff0000\
ce00989680 ceff676980}
tcltest::test int64 int64 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 32767 32768
-32767 -32768 65535 65536 -65535 -65536 2147483647 2147483648
-2147483647 -2147483648 4294967295 4294967296 -4294967295 -4294967296
1000000000000000 -1000000000000000
} {
binary encode hex [msgpack pack int64 $v]
}
} -result {01 00 ff 20 21 e0 d0df 7f cc80 d081 d080 cd0100 cd0101 d1ff01\
d1ff00 cd7fff cd8000 d18001 d18000 cdffff ce00010000 d2ffff0001\
d2ffff0000 ce7fffffff ce80000000 d280000001 d280000000 ceffffffff\
cf0000000100000000 d3ffffffff00000001 d3ffffffff00000000\
cf00038d7ea4c68000 d3fffc72815b398000}
tcltest::test uint64 uint64 -body {
flatmap v {
1 0 -1 32 33 -32 -33 127 128 -127 -128 256 257 -255 -256 32767 32768
-32767 -32768 65535 65536 -65535 -65536 2147483647 2147483648
-2147483647 -2147483648 4294967295 4294967296 -4294967295 -4294967296
1000000000000000 -1000000000000000
} {
binary encode hex [msgpack pack uint64 $v]
}
} -result {01 00 cfffffffffffffffff 20 21 cfffffffffffffffe0\
cfffffffffffffffdf 7f cc80 cfffffffffffffff81 cfffffffffffffff80\
cd0100 cd0101 cfffffffffffffff01 cfffffffffffffff00 cd7fff cd8000\
cfffffffffffff8001 cfffffffffffff8000 cdffff ce00010000\
cfffffffffffff0001 cfffffffffffff0000 ce7fffffff ce80000000\
cfffffffff80000001 cfffffffff80000000 ceffffffff cf0000000100000000\
cfffffffff00000001 cfffffffff00000000 cf00038d7ea4c68000\
cffffc72815b398000}
tcltest::test float32 float32 -body {
flatmap v {1 2 3.1415 123456678 6.54e3} {
binary encode hex [msgpack pack float32 $v]
}
} -result {ca3f800000 ca40000000 ca40490e56 ca4ceb7995 ca45cc6000}
tcltest::test float64 float64 -body {
flatmap v {1 2 3.1415 123456678 6.54e3} {
binary encode hex [msgpack pack float64 $v]
}
} -result {cb3ff0000000000000 cb4000000000000000 cb400921cac083126f\
cb419d6f3298000000 cb40b98c0000000000}
# One can't use -match regexp here because it is limited to 255 repetitions.
# We weep for your terminal if this test fails.
tcltest::test bin bin -body {
flatmap v [list \
{} a bb ccc dddd [string repeat e 255] [string repeat e 256] \
[string repeat f 257] [string repeat g 65535] [string repeat h 65536] \
[string repeat i 100000] \
] {
binary encode hex [msgpack pack bin $v]
}
} -result [list \
c400 \
c40161 \
c4026262 \
c403636363 \
c40464646464 \
c4ff[string repeat 65 255] \
c50100[string repeat 65 256] \
c50101[string repeat 66 257] \
c5ffff[string repeat 67 65535] \
c600010000[string repeat 68 65536] \
c6000186a0[string repeat 69 100000] \
]
tcltest::test bin-unpack-8 bin -body {
msgpack unpack [msgpack pack bin hello]
} -result {{bin hello}}
tcltest::test bin-unpack-16 bin -body {
msgpack unpack [msgpack pack bin hell[string repeat o 300]]
} -match regexp -result {{bin hello{150}o{150}}}
tcltest::test bin-unpack-32 bin -body {
msgpack unpack [msgpack pack bin hell[string repeat o 100000]]
} -match regexp -result {{bin hello+}}
tcltest::test str str -body {
flatmap v [list \
{} a bb ccc dddd [string repeat e 31] [string repeat e 32] \
[string repeat f 33] [string repeat g 65535] [string repeat h 65536] \
[string repeat i 100000] \
] {
binary encode hex [msgpack pack str $v]
}
} -result [list \
a0 \
a161 \
a26262 \
a3636363 \
a464646464 \
bf[string repeat 65 31] \
d920[string repeat 65 32] \
d921[string repeat 66 33] \
daffff[string repeat 67 65535] \
db00010000[string repeat 68 65536] \
db000186a0[string repeat 69 100000] \
]
tcltest::test str-unpack-8 str -body {
msgpack unpack [msgpack pack str hello]
} -result {{str hello}}
tcltest::test str-unpack-16 str -body {
msgpack unpack [msgpack pack str hell[string repeat o 300]]
} -match regexp -result {{str hello{150}o{150}}}
tcltest::test str-unpack-32 str -body {
msgpack unpack [msgpack pack str hell[string repeat o 100000]]
} -match regexp -result {{str hello+}}
tcltest::test array-list array-list -body {
set n 10
set tt {}
append tt [msgpack pack array $n]
set l {}
for {set i 0} {$i < $n} {incr i} {
set v [expr {int(exp($i + $n)) % 100000}]
lappend l $v
append tt [msgpack pack int $v]
}
append tt [msgpack pack true]
# Test list
set tt2 [msgpack pack list int $l]
append tt2 [msgpack pack true]
list [string equal $tt $tt2] [binary encode hex $tt]
} -result {1 9acd560acde9e2cdf522cda5adcd0a2cce00010d99ce0001505ecdd6a8cdea41ce0001417cc3}
tcltest::test map-dict-tcl_array-10-31-32 map-dict-tcl_array-10-31-32 -body {
flatmap n {10 31 32} {
lassign [test_map $n] eq1 eq2 tt
list $eq1 $eq2 [binary encode hex $tt]
}
} -result [list \
1 1 8ad2ffd55d56d2ffff2b7ed2ff8c8568d2ffff2b7ed2ff6dae06d2ffff2b7e00d2ffff2b7ece00158880d2ffff2b7ece003ee260d2ffff2b7ece00643f89d2ffff2b7ece008065f5d2ffff2b7ece008abf6ed2ffff2b7ece0096f6ced2ffff2b7ec3 \
1 1 de001fd2fffea63fd2ffff622dd2ffebce03d2ffff622dd2ffd55d56d2ffff622dd2ffd411c7d2ffff622dd2ffae201fd2ffff622dd2ffacfd2dd2ffff622dd2ff9abcced2ffff622dd2ff8d6890d2ffff622dd2ff8c8568d2ffff622dd2ff7ee084d2ffff622dd2ff75d1d9d2ffff622dd2ff6dae06d2ffff622dd2ff6d4d6ad2ffff622dd2ff693d04d2ffff622dd2ff6769e2d2ffff622d00d2ffff622dce00158880d2ffff622dce0016de94d2ffff622dce00295641d2ffff622dce003ee260d2ffff622dce00401cc6d2ffff622dce006339ded2ffff622dce00643f89d2ffff622dce00745b70d2ffff622dce007fa9dcd2ffff622dce008065f5d2ffff622dce008abf6ed2ffff622dce008b4decd2ffff622dce0091ee6fd2ffff622dce0096f6ced2ffff622dce00972799d2ffff622dc3 \
1 1 de0020d2fffea63fcdd766d2ffebce03cdd766d2ffd55d56cdd766d2ffd411c7cdd766d2ffc25948cdd766d2ffae201fcdd766d2ffacfd2dcdd766d2ff9abccecdd766d2ff8d6890cdd766d2ff8c8568cdd766d2ff7ee084cdd766d2ff75d1d9cdd766d2ff6dae06cdd766d2ff6d4d6acdd766d2ff693d04cdd766d2ff6769e2cdd76600cdd766ce00158880cdd766ce0016de94cdd766ce00295641cdd766ce003ee260cdd766ce00401cc6cdd766ce006339decdd766ce00643f89cdd766ce00745b70cdd766ce007fa9dccdd766ce008065f5cdd766ce008abf6ecdd766ce008b4deccdd766ce0091ee6fcdd766ce0096f6cecdd766ce00972799cdd766c3 \
]
tcltest::test map-dict-tcl_array-65535 map-dict-tcl_array-65535 -body {
lrange [test_map 65535] 0 1
} -result {1 1} -constraints slowTests
tcltest::test map-dict-tcl_array-65536 map-dict-tcl_array-65536} -body {
lrange [test_map 65536] 0 1
} -result {1 1} -constraints slowTests
tcltest::test nested-1 nested -body {
set tt {}
append tt [msgpack pack array 6]
append tt [msgpack pack int 5]
append tt [msgpack pack str vijf]
append tt [msgpack pack int 6]
append tt [msgpack pack dict int str {1 twee 3 vier}]
append tt [msgpack pack int 7]
append tt [msgpack pack str zeven]
msgpack unpack $tt
} -result {{array {{integer 5} {str vijf} {integer 6}\
{map {{integer 1} {str twee} {integer 3} {str vier}}}\
{integer 7} {str zeven}}}}
tcltest::test nested-2 nested -body {
msgpack unpack [binary decode hex 82a7636c69656e747382a46461746194c40567616d6d61c40564656c74610102a5686f73747392c405616c706861c4056f6d656761a8646174616261736583ae636f6e6e656374696f6e5f6d6178cd1388a7656e61626c6564c3a5706f72747393cd1f41cd1f41cd1f42]
} -result {{map {{str clients} {map {{str data} {array {{bin gamma} {bin delta} {integer 1} {integer 2}}} {str hosts} {array {{bin alpha} {bin omega}}}}} {str database} {map {{str connection_max} {integer 5000} {str enabled} {boolean 1} {str ports} {array {{integer 8001} {integer 8001} {integer 8002}}}}}}}}
tcltest::test fix_ext1 fix_ext1 -body {
set enc {}
lappend enc [msgpack pack fix_ext1 42 !]
lappend enc [msgpack pack fix_ext1 -5 \xFF]
set dec [lmap x $enc {msgpack unpack $x}]
concat [lmap x $enc {binary encode hex $x}] $dec
} -result "d42a21 d4fbff {{ext 42 !}} {{ext -5 \xFF}}"
tcltest::test fix_ext2 fix_ext2 -body {
set enc {}
lappend enc [msgpack pack fix_ext2 42 !]
lappend enc [msgpack pack fix_ext2 3 \xCA\xFE]
set dec [lmap x $enc {msgpack unpack $x}]
concat [lmap x $enc {binary encode hex $x}] $dec
} -result "d52a2100 d503cafe {{ext 42 !\x00}} {{ext 3 \xCA\xFE}}"
tcltest::test fix_ext4 fix_ext4 -body {
set enc {}
lappend enc [msgpack pack fix_ext4 42 !]
lappend enc [msgpack pack fix_ext4 3 \xCA\xFE]
lappend enc [msgpack pack fix_ext4 10 \x12\x34\x56\x78]
set dec [lmap x $enc {msgpack unpack $x}]
concat [lmap x $enc {binary encode hex $x}] $dec
} -result "d62a21000000 d603cafe0000 d60a12345678\
{{ext 42 !\x00\x00\x00}} {{ext 3 \xCA\xFE\x00\x00}}\
{{ext 10 \x12\x34\x56\x78}}"
tcltest::test fix_ext8 fix_ext8 -body {
set enc {}
lappend enc [msgpack pack fix_ext8 3 \xCA\xFE]
lappend enc [msgpack pack fix_ext8 10 \x01\x23\x45\x67\x89\xAB\xCD\xEF]
set dec [lmap x $enc {msgpack unpack $x}]
concat [lmap x $enc {binary encode hex $x}] $dec
} -result "d703cafe000000000000 d70a0123456789abcdef\
{{ext 3 \xCA\xFE\0\0\0\0\0\0}}\
{{ext 10 \x01\x23\x45\x67\x89\xAB\xCD\xEF}}"
tcltest::test fix_ext16 fix_ext16 -body {
set enc {}
lappend enc [msgpack pack fix_ext16 3 \xCA\xFE]
lappend enc [msgpack pack fix_ext16 11 [string repeat AB 16]]
set dec [lmap x $enc {msgpack unpack $x}]
concat [lmap x $enc {binary encode hex $x}] $dec
} -result "d803cafe0000000000000000000000000000\
d80b41424142414241424142414241424142\
{{ext 3 \xCA\xFE\0\0\0\0\0\0\0\0\0\0\0\0\0\0}}\
{{ext 11 ABABABABABABABAB}}"
tcltest::test ext ext -body {
flatmap v [list \
{} a bb ccc dddd [string repeat e 255] [string repeat e 256] \
[string repeat f 257] [string repeat g 65535] [string repeat h 65536] \
[string repeat i 100000] \
] {
binary encode hex [msgpack pack ext 127 $v]
}
} -result [list \
c7007f \
c7017f61 \
c7027f6262 \
c7037f636363 \
c7047f64646464 \
c7ff7f[string repeat 65 255] \
c801007f[string repeat 65 256] \
c801017f[string repeat 66 257] \
c8ffff7f[string repeat 67 65535] \
c9000100007f[string repeat 68 65536] \
c9000186a07f[string repeat 69 100000] \
]
tcltest::test ext-timestamp-1 timestamp32 -body {
msgpack unpack [binary decode hex 81a56576656e7482a56c6162656caa74696d6520626567616ea464617465d6ff00000000]
} -result {{map {{str event} {map {{str label} {str {time began}}\
{str date} {timestamp 0 0}}}}}}
tcltest::test ext-timestamp-2 timestamp32 -body {
set enc [msgpack pack timestamp32 1598459831]
list [binary encode hex $enc] [msgpack unpack $enc]
} -result {d6ff5f468fb7 {{timestamp 1598459831 0}}}
tcltest::test ext-timestamp-3 timestamp64 -body {
set enc {}
lappend enc [msgpack pack timestamp64 1598459831 0]
lappend enc [msgpack pack timestamp64 1598459831 123456789]
lappend enc [msgpack pack timestamp64 1598459831 999999999]
flatmap x $enc {
list [binary encode hex $x] [msgpack unpack $x]
}
} -result {d7ff000000005f468fb7 {{timestamp 1598459831 0}}\
d7ff1d6f34545f468fb7 {{timestamp 1598459831 123456789}}\
d7ffee6b27fc5f468fb7 {{timestamp 1598459831 999999999}}}
tcltest::test ext-timestamp-4 timestamp96 -body {
set enc {}
lappend enc [msgpack pack timestamp96 1598459831 0]
lappend enc [msgpack pack timestamp96 1598459831 123456789]
lappend enc [msgpack pack timestamp96 1598459831 999999999]
set tt {}
flatmap x $enc {
list [binary encode hex $x] [msgpack unpack $x]
}
} -result {c70cff00000000000000005f468fb7 {{timestamp 1598459831 0}}\
c70cff075bcd15000000005f468fb7 {{timestamp 1598459831 123456789}}\
c70cff3b9ac9ff000000005f468fb7 {{timestamp 1598459831 999999999}}}
tcltest::test ext-timestamp-5 {milliseconds and microseconds} -body {
set enc {}
lappend enc [msgpack pack milliseconds 1598463308768]
lappend enc [msgpack pack microseconds 1598463300642468]
flatmap x $enc {
list [binary encode hex $x] [msgpack unpack $x]
}
} -result {c70cff2dc6c000000000005f469d4c\
{{timestamp 1598463308 768000000}}\
c70cff264b48a0000000005f469d44\
{{timestamp 1598463300 642468000}}}
tcltest::test ext-unpacker-1 {Add custom unpacker} -setup {
set up [msgpack::unpacker new]
} -cleanup {
catch { $up destroy }
rename ::xor {}
} -body {
proc ::xor {n type data} {
if {$type != 100} { error [list wrong type: $type] }
set res {}
foreach b [split $data {}] {
set code [scan $b %c]
append res [format %c [expr { $code ^ $n }]]
}
return [list encrypted $res]
}
$up set_ext_unpacker 99 {::xor 42}
$up set_ext_unpacker 100 {::xor 5}
$up set_ext_unpacker 1000 {::xor 0}
$up unpack_string [msgpack pack ext 100 M`iij$]
} -result {{encrypted Hello!}}
tcltest::test ext-unpacker-2 {Remove timestamp unpacker} -setup {
set up [msgpack::unpacker new]
} -cleanup {
catch { $up destroy }
} -body {
$up set_ext_unpacker -1 {}
$up unpack_string [msgpack pack timestamp32 1598459831]
} -result "{ext -1 \x5f\x46\x8f\xb7}"
tcltest::test ext-unpacker-3 {Get ext unpackers} -setup {
set up [msgpack::unpacker new]
} -cleanup {
catch { $up destroy }
} -body {
set tt {}
lappend tt [$up set_ext_unpacker]
lappend tt [$up set_ext_unpacker -1]
} -match regexp -result {\s*-1 \{apply \{\{type data\}.*apply}
tcltest::test pack-unknown-type pack-unknown-type -body {
msgpack pack foo 99
} -returnCodes error -result {unknown type: foo}
tcltest::test unpack-not-long-enough-array unpack-not-long-enough -body {
msgpack unpack \xDC\x00\x05\xFF
} -match glob -returnCodes error -result {input string not long enough*}
tcltest::test unpack-not-long-enough-bin unpack-not-long-enough -body {
msgpack unpack \xC4\x05\xFF
} -returnCodes error -result {input string not long enough,\
need 5 byte(s), only 1 left}
tcltest::test unpack-not-long-enough-ext unpack-not-long-enough -body {
msgpack unpack \xC7\x05\x01\xFF
} -returnCodes error -result {input string not long enough,\
need 5 byte(s), only 1 left}
tcltest::test unpack-not-long-enough-str unpack-not-long-enough -body {
msgpack unpack \xD9\x05\xFF
} -returnCodes error -result {input string not long enough,\
need 5 byte(s), only 1 left}
proc mts_unhex hex {
binary decode hex [string map {- {}} $hex]
}
proc mts_test_file filename {
set ch [open [file join $::mtsPath $filename] r]
chan configure $ch -encoding utf-8
set yaml [read $ch]
close $ch
return $yaml
}
proc mts_test {filename {key %AUTO%}} {
set tests [yaml::yaml2dict [mts_test_file $filename]]
flatmap test $tests {
set ref [dict get $test [if {$key eq {%AUTO%}} {
lsearch -inline -not [dict keys $test] msgpack
} else {
lindex $key
}]]
set unpacked [flatmap x [dict get $test msgpack] {
set packed [mts_unhex $x]
msgpack unpack $packed
}]
list $ref $unpacked
}
}
tcltest::test msgpack-test-suite-array {} -body {
set filename 40.array.yaml
foreach {ref values} [mts_test $filename] {
foreach value $values {
set a [lmap x [lindex $value 1] { lindex $x 1 }]
if {$a ne $ref} {
error [list unpacked array $a ne $ref in $filename]
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-binary {} -body {
set filename 12.binary.yaml
foreach {ref values} [mts_test $filename] {
set ref [mts_unhex $ref]
foreach value $values {
set b [lindex $value 1]
if {$b ne $ref} {
error [list unpacked binary $b ne $ref in $filename]
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-ext {} -body {
set filename 60.ext.yaml
foreach {ref values} [mts_test $filename] {
lset ref 1 [mts_unhex [lindex $ref 1]]
foreach value $values {
set e [lrange $value 1 end]
if {$e ne $ref} {
error [list unpacked binary $e ne $ref in $filename]
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-nested {} -body {
set filename 42.nested.yaml
foreach {ref values} [mts_test $filename] {
foreach value $values {
set m [lmap x [lindex $value 1] { lindex $x 1 }]
if {$m ne $ref} {
error [list unpacked array $m ne $ref in $filename]
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-number {} -body {
foreach filename {
20.number-positive.yaml
21.number-negative.yaml
22.number-float.yaml
23.number-bignum.yaml
} {
foreach {ref values} [mts_test $filename] {
foreach value $values {
set n [lindex $value 1]
if {$n != $ref} {
error [list unpacked number $n != $ref in $filename]
}
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-string {} -body {
foreach filename {
30.string-ascii.yaml
31.string-utf8.yaml
32.string-emoji.yaml
} {
foreach {ref values} [mts_test $filename] {
foreach value $values {
set s [lindex $value 1]
if {$s ne $ref} {
error [list unpacked string $s ne $ref in $filename]
}
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-timestamp {} -body {
set filename 50.timestamp.yaml
foreach {ref values} [mts_test $filename] {
foreach value $values {
set t [lrange $value 1 2]
if {$t ne $ref} {
error [list unpacked timestamp $t ne $ref in $filename]
}
}
}
} -result {} -constraints yaml
tcltest::test msgpack-test-suite-pack-utf8 {} -body {
set tests [yaml::yaml2dict [mts_test_file 31.string-utf8.yaml]]
flatmap test $tests {
set ref [dict get $test string]
set hex [flatmap x [dict get $test msgpack] {
string map {- {}} $x
}]
set hexPacked [binary encode hex [msgpack pack str $ref]]
if {$hexPacked ni $hex} {
error [list packed $ref eq $hexPacked not in list $hex]
}
}
} -result {} -constraints yaml
# Exit with a nonzero status if there are failed tests.
set failed [expr {$tcltest::numTests(Failed) > 0}]
tcltest::cleanupTests
if {$failed} { exit 1 }