Skip to content

Instantly share code, notes, and snippets.

@abicky

abicky/msgpack.R

Last active December 10, 2015 12:19
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save abicky/4433343 to your computer and use it in GitHub Desktop.
Save abicky/4433343 to your computer and use it in GitHub Desktop.
Download ZIP
MessagePack for R (support only unpack)
Raw
msgpack.R
#---------------------------------------------------------------------
# MessagePack for R (support only unpack)
#
# Copyright 2013- Takeshi Arabiki
# License: MIT License (http://opensource.org/licenses/MIT)
#
# > source("msgpack.R")
# > msgpack$unpack("\x93\x01\x02\x03")
# [1] 1 2 3
# > msgpack$unpack(c(charToRaw("\xCD\x01"), as.raw(0x00)))
# [1] 256
#
# See also: http://msgpack.org/
#---------------------------------------------------------------------
msgpack <- list()
msgpack$.SEEK.SET <- 0
msgpack$.SEEK.CUR <- 1
msgpack$.SEEK.END <- 2
msgpack$.offset <- 1 # 1-origin
msgpack$.seek <- function(offset, whence = msgpack$.SEEK.SET) {
if (whence == msgpack$.SEEK.SET) {
msgpack$.offset <<- offset
} else if (whence == msgpack$.SEEK.CUR) {
msgpack$.offset <<- msgpack$.offset + offset
} else if (whence == msgpack$.SEEK.END) {
stop("SEEK.END is not supported")
} else {
stop("invalid whence")
}
}
msgpack$.reset <- function() {
msgpack$.seek(1, msgpack$.SEEK.SET)
}
msgpack$unpack <- function(binary) {
if (msgpack$.offset == 1) {
if (is.character(binary)) {
binary <- charToRaw(binary)
}
on.exit(msgpack$.reset())
}
currentByte <- msgpack$.getByte(binary)
if (currentByte < 0x80) {
# Positive FixNum (unsigned int 8)
value <- as.integer(currentByte)
} else if (currentByte < 0x90) {
# FixMap
n <- as.integer(currentByte & as.raw(0x0f))
value <- msgpack$.makeMap(binary, n)
} else if (currentByte < 0xa0) {
# FixArray
n <- as.integer(currentByte & as.raw(0x0f))
value <- msgpack$.makeArray(binary, n)
} else if (currentByte < 0xc0) {
# FixRaw
n <- as.integer(currentByte & as.raw(0x1f))
value <- msgpack$.makeCharacter(binary, n)
} else if (currentByte == 0xc0) {
# nil
value <- NA
} else if (currentByte == 0xc1) {
# reserved
} else if (currentByte == 0xc2) {
# false
value <- FALSE
} else if (currentByte == 0xc3) {
# true
value <- TRUE
} else if (currentByte < 0xca) {
# reserved
} else if (currentByte == 0xca) {
# float
value <- msgpack$.makeFloat(binary)
} else if (currentByte == 0xcb) {
# double
value <- msgpack$.makeDouble(binary)
} else if (currentByte == 0xcc) {
# uint 8
value <- msgpack$.makeUint(binary, 8)
} else if (currentByte == 0xcd) {
# uint 16
value <- msgpack$.makeUint(binary, 16)
} else if (currentByte == 0xce) {
# uint 32
value <- msgpack$.makeUint(binary, 32)
} else if (currentByte == 0xcf) {
# uint 64
value <- msgpack$.makeUint(binary, 64)
} else if (currentByte == 0xd0) {
# int 8
value <- msgpack$.makeInt(binary, 8)
} else if (currentByte == 0xd1) {
# int 16
value <- msgpack$.makeInt(binary, 16)
} else if (currentByte == 0xd2) {
# int 32
value <- msgpack$.makeInt(binary, 32)
} else if (currentByte == 0xd3) {
# int 64
value <- msgpack$.makeInt(binary, 64)
} else if (currentByte < 0xda) {
# reserved
} else if (currentByte == 0xda) {
# raw 16
n <- msgpack$.getLength(binary, 2)
value <- msgpack$.makeCharacter(binary, n)
} else if (currentByte == 0xdb) {
# raw 32
n <- msgpack$.getLength(binary, 4)
value <- msgpack$.makeCharacter(binary, n)
} else if (currentByte == 0xdc) {
# array 16
n <- msgpack$.getLength(binary, 2)
value <- msgpack$.makeArray(binary, n)
} else if (currentByte == 0xdd) {
# array 32
n <- msgpack$.getLength(binary, 4)
value <- msgpack$.makeArray(binary, n)
} else if (currentByte == 0xde) {
# map 16
n <- msgpack$.getLength(binary, 2)
value <- msgpack$.makeMap(binary, n)
} else if (currentByte == 0xdf) {
# map 32
n <- msgpack$.getLength(binary, 4)
value <- msgpack$.makeMap(binary, n)
} else {
# Negative FixNum (int 8)
value <- packBits(rawToBits(c(currentByte, rep(as.raw(0xff), 3))), type = "integer")
}
return(value)
}
msgpack$.getByte <- function(binary) {
byte <- binary[msgpack$.offset]
msgpack$.seek(1, msgpack$.SEEK.CUR)
return(byte)
}
msgpack$.getKey <- function(binary) {
currentByte <- msgpack$.getByte(binary)
if (0xa0 <= currentByte && currentByte < 0xc0) {
# FixRaw
n <- as.integer(currentByte & as.raw(0x1f))
} else if (currentByte == 0xda) {
# raw 16
n <- msgpack$.getLength(binary, 2)
} else if (currentByte == 0xdb) {
# raw 32
n <- msgpack$.getLength(binary, 4)
} else {
stop("invalid format")
}
key <- rawToChar(binary[0:(n - 1) + msgpack$.offset])
msgpack$.seek(n, msgpack$.SEEK.CUR)
return(key)
}
msgpack$.checkTypes <- function(values) {
types <- unique(unlist(lapply(values, function(x) {
if (is.na(x)) {
return(NULL)
} else {
return(class(x))
}
})))
if (length(types) == 1) {
class(values) <- types
}
return(values)
}
msgpack$.getLength <- function(binary, read.bytes) {
n <- packBits(rawToBits(c(binary[(read.bytes - 1):0 + msgpack$.offset], rep(as.raw(0x00), 4 - read.bytes))), type = "integer")
msgpack$.seek(read.bytes, msgpack$.SEEK.CUR)
return(n)
}
msgpack$.makeUint <- function(binary, bit) {
readBytes <- bit / 8
if (bit == 8) {
value <- binary[msgpack$.offset]
} else if (bit %in% c(16, 32, 64)) {
value <- as.numeric(paste0("0x", paste(binary[0:(readBytes - 1) + msgpack$.offset], collapse = "")))
} else {
stop("invalid type")
}
if (value <= .Machine$integer.max) {
value <- as.integer(value)
}
msgpack$.seek(readBytes, msgpack$.SEEK.CUR)
return(value)
}
msgpack$.makeInt <- function(binary, bit) {
readBytes <- bit / 8
if (bit == 8) {
value <- packBits(rawToBits(c(binary[msgpack$.offset], rep(as.raw(0xff), 3))), type = "integer")
} else if (bit == 16 || bit == 32) {
bits <- rawToBits(c(binary[(readBytes - 1):0 + msgpack$.offset], rep(as.raw(0xff), 4 - readBytes)))
if (bits[length(bits)] == 1 && all(bits[-length(bits)] == 0)) {
# minimum integer is 1 + INT_MIN (= -2^32) because INT_MIN is NA_INTEGER
value <- -2^31
} else {
value <- packBits(bits, type = "integer")
}
} else if (bit == 64) {
value <- as.numeric(paste0("0x", paste(binary[0:7 + msgpack$.offset], collapse = ""))) - 0xffffffffffffffff - 1
} else {
stop("invalid type")
}
msgpack$.seek(readBytes, msgpack$.SEEK.CUR)
return(value)
}
msgpack$.makeFloat <- function(binary) {
value <- msgpack$.binToFloat(binary[0:3 + msgpack$.offset])
msgpack$.seek(4, msgpack$.SEEK.CUR)
return(value)
}
msgpack$.makeDouble <- function(binary) {
value <- msgpack$.binToDouble(binary[0:7 + msgpack$.offset])
msgpack$.seek(8, msgpack$.SEEK.CUR)
return(value)
}
msgpack$.makeCharacter <- function(binary, n) {
chars <- rawToChar(binary[0:(n - 1) + msgpack$.offset])
msgpack$.seek(n, msgpack$.SEEK.CUR)
return(chars)
}
msgpack$.makeArray <- function(binary, n) {
arr <- vector(mode = "list", n)
for (i in 1:n) {
arr[[i]] <- msgpack$unpack(binary)
}
arr <- msgpack$.checkTypes(arr)
return(arr)
}
msgpack$.makeMap <- function(binary, n) {
map <- vector(mode = "list", n)
keys <- character(n)
for (i in 1:n) {
keys[i] <- msgpack$.getKey(binary)
map[[i]] <- msgpack$unpack(binary)
}
names(map) <- keys
map <- msgpack$.checkTypes(map)
return(map)
}
msgpack$.binToDouble <- function(binary) {
return(msgpack$.binToNumeric(binary, 11, 52, 1023))
}
msgpack$.binToFloat <- function(binary) {
return(msgpack$.binToNumeric(binary, 8, 23, 127))
}
msgpack$.binToNumeric <- function(binary, expSize, fracSize, bias) {
bits <- rev(rawToBits(rev(binary)))
sign <- as.integer(bits[1])
exp <- packBits(c(bits[rev(seq.int(2, length = expSize))], rep(as.raw(0), 32 - expSize)), type = "integer")
frac <- as.numeric(paste0("0x", paste(binary[-1] & as.raw(c(0x0f, rep(0xff, length(binary) - 2))), collapse = "")))
# special cases
if (exp == 0) {
if (frac == 0) {
return(0)
} else {
# subnormal numbers
return((-1)^sign * frac * 2^(- fracSize - bias + 1))
}
} else if (exp == 2^expSize - 1) {
if (frac == 0) {
return((-1)^sign * Inf)
} else {
return(NaN)
}
}
return((-1)^sign * (2^fracSize + frac) * 2^(exp - fracSize - bias))
}
Raw
test.msgpack.R
#-----------------------------------------------------------
# Test script for msgpack.R
# Generated by Runit command on 2013-01-02 at 17:26:28
# cf. https://gist.github.com/1580439
#-----------------------------------------------------------
source("/path/to/msgpack.R")
# This function is executed directly before each test function execution
.setUp <- function() {
}
# This function is executed directly after each test function execution
.tearDown <- function() {
}
`test.msgpack$.binToDouble` <- function() {
# cf. http://en.wikipedia.org/wiki/Single-precision_floating-point_format
testcases <- list(
list(
msg = as.raw(c(0x3f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = 1
),
list(
msg = as.raw(c(0x3f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01)),
expected = 1 + .Machine$double.eps
),
list(
msg = as.raw(c(0x3f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02)),
expected = 1 + .Machine$double.eps * 2
),
list(
msg = as.raw(c(0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = 2
),
list(
msg = as.raw(c(0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = -2
),
list(
msg = as.raw(c(0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01)),
expected = 2^-1074
),
list(
msg = as.raw(c(0x00, 0x0f, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff)),
expected = (2^52 - 1) * 2^-1074
),
list(
msg = as.raw(c(0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = .Machine$double.xmin
),
list(
msg = as.raw(c(0x7f, 0xef, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff)),
expected = .Machine$double.xmax
),
list(
msg = as.raw(c(0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = 0
),
list(
msg = as.raw(c(0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = 0
),
list(
msg = as.raw(c(0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = Inf
),
list(
msg = as.raw(c(0xff, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = -Inf
),
list(
msg = as.raw(c(0x3f, 0xd5, 0x55, 0x55, 0x55, 0x55, 0x55, 0x55)),
expected = 1/3
),
list(
msg = as.raw(c(0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00)),
expected = NaN
)
)
for (testcase in testcases) {
actual <- msgpack$.binToDouble(testcase$msg)
expected <- testcase$expected
checkIdentical(actual, expected,
msg = showDiff(actual, expected))
}
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.binToFloat` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.binToNumeric` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.checkTypes` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.getByte` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.getKey` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.getLength` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeArray` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeCharacter` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeDouble` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeFloat` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeInt` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeMap` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.makeUint` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.reset` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$.seek` <- function() {
# Remove the following line when you implement this test.
DEACTIVATED("This test has not been implemented yet.")
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
`test.msgpack$unpack` <- function() {
testcases <- list(
# Positive FixNum (unsigned int 8)
list(
desc = "Positive FixNum (zero)",
msg = as.raw(0x00),
expected = 0L
),
list(
desc = "Positive FixNum (127)",
msg = "\x7F",
expected = 127L
),
# FixMap
list(
desc = "FixMap (integers)",
msg = "\x84\xA1\x61\x01\xA1\x62\x02\xA1\x63\x03\xA1\x64\xC0",
expected = c(a = 1L, b = 2L, c = 3L, d = NA)
),
list(
desc = "FixMap (mixed)",
msg = c( # "\x83\xA1\x61\x01\xA1\x62\xCB\x40\x00\xCC\xCC\xCC\xCC\xCC\xCD\xA1\x63\xA13"
charToRaw("\x83\xA1\x61\x01\xA1\x62\xCB\x40"),
as.raw(0x00),
charToRaw("\xCC\xCC\xCC\xCC\xCC\xCD\xA1\x63\xA13")
),
expected = list(a = 1L, b = 2.1, c = "3")
),
# FixArray
list(
desc = "FixArray (integers)",
msg = "\x94\x01\x02\x03\xC0",
expected = c(1L, 2L, 3L, NA)
),
list(
desc = "FixArray (mixed)",
msg = c( # "\x93\x01\xCB\x40\x00\xCC\xCC\xCC\xCC\xCC\xCD\xA1\x33"
charToRaw("\x93\x01\xCB\x40"),
as.raw(0x00),
charToRaw("\xCC\xCC\xCC\xCC\xCC\xCD\xA1\x33")
),
expected = list(1L, 2.1, "3")
),
# FixRaw
list(
desc = "FixRaw (English)",
msg = "\xAC\x48\x65\x6C\x6C\x6F\x20\x57\x6F\x72\x6C\x64\x21",
expected = "Hello World!"
),
list(
desc = "FixRaw (Japanese)",
msg = "\xAF\xE3\x81\x82\xE3\x81\x84\xE3\x81\x86\xE3\x81\x88\xE3\x81\x8A",
expected = "あいうえお"
),
# nil
list(
desc = "nil",
msg = "\xC0",
expected = NA
),
# false
list(
desc = "false",
msg = "\xC2",
expected = FALSE
),
# true
list(
desc = "true",
msg = "\xC3",
expected = TRUE
),
# float
# list(
# msg = "\xCB\x3F\xB9\x99\x99\x99\x99\x99\x9A"
# expected = 0.1
# ),
# double
list(
desc = "double",
msg = "\xCB\x3F\xB9\x99\x99\x99\x99\x99\x9A",
expected = 0.1
),
# uint 8
list(
desc = "uint 8 (lower limit)",
msg = "\xCC\x80",
expected = as.integer(2^7)
),
list(
desc = "uint 8 (upper limit)",
msg = "\xCC\xFF",
expected = as.integer(2^8 - 1)
),
# uint 16
list(
desc = "uint 16 (lower limit)",
msg = c( # "\xCD\x01\x00",
charToRaw("\xCD\x01"),
as.raw(0x00)
),
expected = as.integer(2^8)
),
list(
desc = "uint 16 (upper limit)",
msg = "\xCD\xFF\xFF",
expected = as.integer(2^16 - 1)
),
# uint 32
list(
desc = "uint 32 (lower limit)",
msg = c( # "\xCE\x00\x01\x00\x00",
charToRaw("\xCE"),
as.raw(0x00),
charToRaw("\x01"),
rep(as.raw(0x00), 2)
),
expected = as.integer(2^16)
),
list(
desc = "uint 32 (upper limit of integer)",
msg = "\xCE\x7F\xFF\xFF\xFF",
expected = as.integer(2^31 - 1)
),
list(
desc = "uint 32 (upper limit)",
msg = "\xCE\xFF\xFF\xFF\xFF",
expected = 2^32 - 1
),
# uint 64
list(
desc = "uint 64 (lower limit)",
msg = c( # "\xCF\x00\x00\x00\x01\x00\x00\x00\x00",
charToRaw("\xCF"),
rep(as.raw(0x00), 3),
charToRaw("\x01"),
rep(as.raw(0x00), 4)
),
expected = 2^32
),
list(
desc = "uint 64 (upper limit)",
msg = "\xCF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF",
expected = 2^64 - 1
),
# int 8
list(
desc = "int 8 (upper limit)",
msg = "\xD0\xDF",
expected = -as.integer(2^5 + 1)
),
list(
desc = "int 8 (lower limit)",
msg = "\xD0\x80",
expected = -as.integer(2^7)
),
# int 16
list(
desc = "int 16 (upper limit)",
msg = "\xD1\xFF\x7F",
expected = -as.integer(2^7 + 1)
),
list(
desc = "int 16 (lower limit)",
msg = c( # "\xD1\x80\x00",
charToRaw("\xD1\x80"),
as.raw(0x00)
),
expected = -as.integer(2^15)
),
# int 32
list(
desc = "int 32 (upper limit)",
msg = "\xD2\xFF\xFF\x7F\xFF",
expected = -as.integer(2^15 + 1)
),
list(
desc = "int 32 (lower limit of integer)",
msg = c( # "\xD2\x80\x00\x00\x01"
charToRaw("\xD2\x80"),
rep(as.raw(0x00), 2),
charToRaw("\x01")
),
expected = -as.integer(2^31 - 1)
),
list(
desc = "int 32 (lower limit)",
msg = c( # "\xD2\x80\x00\x00\x00",
charToRaw("\xD2\x80"),
rep(as.raw(0x00), 3)
),
expected = -2^31
),
# int 64
list(
desc = "int 64 (upper limit)",
msg = "\xD3\xFF\xFF\xFF\xFF\x7F\xFF\xFF\xFF",
expected = -(2^31 + 1)
),
list(
desc = "int 64 (lower limit)",
msg = c( # "\xD3\x80\x00\x00\x00\x00\x00\x00\x00",
charToRaw("\xD3\x80"),
rep(as.raw(0x00), 7)
),
expected = -(2^63)
),
# raw 16
list(
desc = "raw 16 (1)",
msg = c( # "\xDA\x00\x20abcdefghigklmnopqrstuvwxyzABCDEF"
charToRaw("\xDA"),
as.raw(0x00),
charToRaw("\x20abcdefghigklmnopqrstuvwxyzABCDEF")
),
expected = "abcdefghigklmnopqrstuvwxyzABCDEF"
),
list(
desc = "raw 16 (2)",
msg = c( # "\xDA\x00\x23abcdefghigklmnopqrstuvwxyzABCDEF\xE3\x81\x82"
charToRaw("\xDA"),
as.raw(0x00),
charToRaw("\x23abcdefghigklmnopqrstuvwxyzABCDEF\xE3\x81\x82")
),
expected = "abcdefghigklmnopqrstuvwxyzABCDEFあ"
),
# raw 32
list(
desc = "raw 32 (1)",
msg = c( # "\xDB\x00\x01\x00\x00a..."
charToRaw("\xDB"),
as.raw(0x00),
charToRaw("\x01"),
rep(as.raw(0x00), 2),
charToRaw(paste(rep("a", 2^16), collapse = ""))
),
expected = paste(rep("a", 2^16), collapse = "")
),
list(
desc = "raw 32 (2)",
msg = c( # "\xDB\x00\x01\x00\x00a...あ"
charToRaw("\xDB"),
as.raw(0x00),
charToRaw("\x01"),
as.raw(0x00),
charToRaw(paste0("\03", paste(rep("a", 2^16), collapse = ""), "\xE3\x81\x82"))
),
expected = paste(c(rep("a", 2^16), "あ"), collapse = "")
),
# array 16
list(
desc = "array 16 (1)",
msg = c( # "\xDC\x00\x10\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\x10"
charToRaw("\xDC"),
as.raw(0x00),
charToRaw("\x10\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F\x10")
),
expected = 1:16
),
# array 32
# list(
# msg = c( # "\xDD\x00\x01\x00\x00\x01\x02...\xCE\x00\x01\x00\x00"
# charToRaw("\xDD"),
# as.raw(0x00),
# ),
# expected = 1:2^16
# ),
# map 16
list(
desc = "map 16",
msg = c( # "\xDE\x00\x10\xA1a\x01\xA1b\x02\xA1c\x03\xA1d\x04\xA1e\x05\xA1f\x06\xA1g\a\xA1h\b\xA1i\t\xA1j\n\xA1k\v\xA1l\f\xA1m\r\xA1n\x0E\xA1o\x0F\xA1p\x10"
charToRaw("\xDE"),
as.raw(0x00),
charToRaw("\x10\xA1a\x01\xA1b\x02\xA1c\x03\xA1d\x04\xA1e\x05\xA1f\x06\xA1g\a\xA1h\b\xA1i\t\xA1j\n\xA1k\v\xA1l\f\xA1m\r\xA1n\x0E\xA1o\x0F\xA1p\x10")
),
expected = structure(1:16, names = letters[1:16])
),
# map 32
# Negative FixNum
list(
desc = "map 32",
msg = "\xFF",
expected = -1L
),
list(
msg = "\xE0",
expected = -32L
)
)
for (testcase in testcases) {
actual <- msgpack$unpack(testcase$msg)
expected <- testcase$expected
checkIdentical(actual, expected,
msg = showDiff(actual, expected, testcase$desc))
}
# next code is executed if this test script is executed using Runit command
if (exists("checkFailure") && is.function(checkFailure)) {
checkFailure()
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment