test_raw-utils.R
In S4Vectors: Foundation of vector-like and list-like containers in Bioconductor

test_extract_character_from_raw_by_positions <- function()
{
    TOLOWER_LOOKUP <- S4Vectors:::TOLOWER_LOOKUP
    extract_character_from_raw_by_positions <-
        S4Vectors:::extract_character_from_raw_by_positions

    do_tests <- function(x, pos, target0, lkup, target1) {
        current <- extract_character_from_raw_by_positions(x, pos)
        checkIdentical(target0, current)

        current <- extract_character_from_raw_by_positions(x, pos,
                                                           collapse=TRUE)
        target <- paste0(target0, collapse="")
        checkIdentical(target, current)

        current <- extract_character_from_raw_by_positions(x, pos, lkup=lkup)
        checkIdentical(target1, current)

        current <- extract_character_from_raw_by_positions(x, pos,
                                                           collapse=TRUE,
                                                           lkup=lkup)
        target <- paste0(target1, collapse="")
        checkIdentical(target, current)
    }

    x <- charToRaw("ABCDEFAAA")
    weird_lkup <- c(rep.int(NA_integer_, 65L), 122:117)

    pos <- integer(0)
    target0 <- target1 <- character(0)
    do_tests(x, pos, target0, TOLOWER_LOOKUP, target1)
    do_tests(x, pos, target0, weird_lkup, target1)

    pos <- c(6L, 9L, 1L)
    target0 <- substring(rawToChar(x), pos, pos)
    target1 <- c("f", "a", "a")
    do_tests(x, pos, target0, TOLOWER_LOOKUP, target1)
    target1 <- c("u", "z", "z")
    do_tests(x, pos, target0, weird_lkup, target1)

    pos <- seq_along(x)
    target0 <- safeExplode(rawToChar(x))
    target1 <- c("a", "b", "c", "d", "e", "f", "a", "a", "a")
    do_tests(x, pos, target0, TOLOWER_LOOKUP, target1)
    target1 <- c("z", "y", "x", "w", "v", "u", "z", "z", "z")
    do_tests(x, pos, target0, weird_lkup, target1)

    ## With byte not mapped in lookup table.
    x <- charToRaw("ABCDEFAAAGF")  # 'G' is not mapped in 'weird_lkup'
    pos <- seq_along(x)
    checkException(extract_character_from_raw_by_positions(x, pos,
                                                           lkup=weird_lkup))
    checkException(extract_character_from_raw_by_positions(x, pos,
                                                           collapse=TRUE,
                                                           lkup=weird_lkup))
    pos <- 1:9
    target0 <- substring(rawToChar(x), pos, pos)
    target1 <- c("z", "y", "x", "w", "v", "u", "z", "z", "z")
    do_tests(x, pos, target0, weird_lkup, target1)

    x <- charToRaw("ABCDEFAAA8F")  # '8' is not mapped in 'weird_lkup'
    pos <- seq_along(x)
    checkException(extract_character_from_raw_by_positions(x, pos,
                                                           lkup=weird_lkup))
    checkException(extract_character_from_raw_by_positions(x, pos,
                                                           collapse=TRUE,
                                                           lkup=weird_lkup))
    pos <- 1:9
    target0 <- substring(rawToChar(x), pos, pos)
    target1 <- c("z", "y", "x", "w", "v", "u", "z", "z", "z")
    do_tests(x, pos, target0, weird_lkup, target1)
}

test_extract_character_from_raw_by_ranges <- function()
{
    TOLOWER_LOOKUP <- S4Vectors:::TOLOWER_LOOKUP
    extract_character_from_raw_by_ranges <-
        S4Vectors:::extract_character_from_raw_by_ranges

    do_tests <- function(x, start, width, target0, lkup, target1) {
        current <- extract_character_from_raw_by_ranges(x, start, width)
        checkIdentical(target0, current)

        current <- extract_character_from_raw_by_ranges(x, start, width,
                                                        collapse=TRUE)
        target <- paste0(target0, collapse="")
        checkIdentical(target, current)

        current <- extract_character_from_raw_by_ranges(x, start, width,
                                                        lkup=lkup)
        checkIdentical(target1, current)

        current <- extract_character_from_raw_by_ranges(x, start, width,
                                                        collapse=TRUE,
                                                        lkup=lkup)
        target <- paste0(target1, collapse="")
        checkIdentical(target, current)
    }

    x <- charToRaw("ABCDEFAAA")
    weird_lkup <- c(rep.int(NA_integer_, 65L), 122:117)

    start <- width <- integer(0)
    target0 <- target1 <- character(0)
    do_tests(x, start, width, target0, TOLOWER_LOOKUP, target1)
    do_tests(x, start, width, target0, weird_lkup, target1)

    start <- c(6L, 10L, 1L)
    width <- c(2L,  0L, 9L)
    target0 <- substring(rawToChar(x), start, start + width - 1L)
    target1 <- c("fa", "", "abcdefaaa")
    do_tests(x, start, width, target0, TOLOWER_LOOKUP, target1)
    target1 <- c("uz", "", "zyxwvuzzz")
    do_tests(x, start, width, target0, weird_lkup, target1)

    start <- seq_along(x)
    width <- rep.int(1L, length(x))
    target0 <- safeExplode(rawToChar(x))
    target1 <- c("a", "b", "c", "d", "e", "f", "a", "a", "a")
    do_tests(x, start, width, target0, TOLOWER_LOOKUP, target1)
    target1 <- c("z", "y", "x", "w", "v", "u", "z", "z", "z")
    do_tests(x, start, width, target0, weird_lkup, target1)

    ## Error when too many characters to read.
    xx <- rep.int(x, 1e6)
    start <- rep.int(1L, 239)
    width <- rep.int(length(xx), 239)
    checkException(extract_character_from_raw_by_ranges(xx, start, width,
                                                        collapse=TRUE))

    ## With byte not mapped in lookup table.
    x <- charToRaw("ABCDEFAAAGF")  # 'G' is not mapped in 'weird_lkup'
    start <- c(6L, 10L, 9L)
    width <- c(2L,  0L, 3L)
    checkException(extract_character_from_raw_by_ranges(x, start, width,
                                                        lkup=weird_lkup))
    checkException(extract_character_from_raw_by_ranges(x, start, width,
                                                        collapse=TRUE,
                                                        lkup=weird_lkup))
    start <- c(6L, 10L, 11L)
    width <- c(2L,  0L,  1L)
    target0 <- substring(rawToChar(x), start, start + width - 1L)
    target1 <- c("uz", "", "u")
    do_tests(x, start, width, target0, weird_lkup, target1)

    x <- charToRaw("ABCDEFAAA8F")  # '8' is not mapped in 'weird_lkup'
    start <- c(6L, 10L, 9L)
    width <- c(2L,  0L, 3L)
    checkException(extract_character_from_raw_by_ranges(x, start, width,
                                                        lkup=weird_lkup))
    checkException(extract_character_from_raw_by_ranges(x, start, width,
                                                        collapse=TRUE,
                                                        lkup=weird_lkup))
    start <- c(6L, 10L, 11L)
    width <- c(2L,  0L,  1L)
    target0 <- substring(rawToChar(x), start, start + width - 1L)
    target1 <- c("uz", "", "u")
    do_tests(x, start, width, target0, weird_lkup, target1)
}