diff --git a/paws.common/DESCRIPTION b/paws.common/DESCRIPTION index 8b3825ca3..194702948 100644 --- a/paws.common/DESCRIPTION +++ b/paws.common/DESCRIPTION @@ -1,7 +1,7 @@ Package: paws.common Type: Package Title: Paws Low-Level Amazon Web Services API -Version: 0.7.2 +Version: 0.7.3 Authors@R: c( person("David", "Kretch", email = "david.kretch@gmail.com", role = "aut"), person("Adam", "Banker", email = "adam.banker39@gmail.com", role = "aut"), diff --git a/paws.common/NEWS.md b/paws.common/NEWS.md index 38c0077c9..1dcdb7afc 100644 --- a/paws.common/NEWS.md +++ b/paws.common/NEWS.md @@ -1,3 +1,6 @@ +# paws.common 0.7.3 +* fix `xml_parse` to correctly parse empty elements (#783) thanks to @stevepowell99 for raising issue + # paws.common 0.7.2 * improve performance of `restxml_unmarshal` by x3 * fix `rest_unmarshal_location_elements` only skip header if location is not found (#761) diff --git a/paws.common/R/xmlutil.R b/paws.common/R/xmlutil.R index 9fe7dc601..c722a21bb 100644 --- a/paws.common/R/xmlutil.R +++ b/paws.common/R/xmlutil.R @@ -289,7 +289,7 @@ xml_parse_structure <- function(xml_elts, interface_i, tags_i, tag_type = NULL, # the `is.list()` check is necessary because e.g. `CheckSumAlgorithm` has # a list interface though it isn't a list?! if (isTRUE(flattened) && is.list(result)) { - result <- .mapply(list, result, NULL) + result <- transpose(result) } else { result <- as.list(result) } @@ -358,7 +358,7 @@ xml_parse_list <- function(xml_elts, interface_i, tags_i, tag_type = NULL, flatt # the `is.list()` check is necessary because e.g. `CheckSumAlgorithm` has # a list interface though it isn't a list?! if (isTRUE(flattened) && is.list(result)) { - result <- .mapply(list, result, NULL) + result <- transpose(result) } return(result) @@ -460,3 +460,10 @@ default_parse_scalar <- function(interface_i, tag_type = NULL) { ) return(result) } + +transpose <- function(x) { + if (any(found <- lengths(x) == 0)) { + x[found] <- list(rep(list(), length.out = length(x[[1]]))) + } + .mapply(list, x, NULL) +} diff --git a/paws.common/cran-comments.md b/paws.common/cran-comments.md index 6693914fc..c4f4fbcb1 100644 --- a/paws.common/cran-comments.md +++ b/paws.common/cran-comments.md @@ -1,5 +1,5 @@ ## Submission -This release contains bug fixes and minor performance enhancements +This release contains a hotfix. ## Test environments diff --git a/paws.common/tests/testthat/test_xmlutil.R b/paws.common/tests/testthat/test_xmlutil.R index 68c681458..d01b2e141 100644 --- a/paws.common/tests/testthat/test_xmlutil.R +++ b/paws.common/tests/testthat/test_xmlutil.R @@ -70,3 +70,20 @@ test_that("check nested xml build with nested default parameters", { actual <- xml_build(params_nested) expect_equal(actual, list(nested = list(cho = list("")))) }) + +test_that("check if list is transposed correctly", { + obj <- list( + var1 = c(1, 2, 3), + var2 = letters[1:3], + var3 = list(), + var4 = list() + ) + expected <- list( + list(var1 = 1, var2 = "a", var3 = NULL, var4 = NULL), + list(var1 = 2, var2 = "b", var3 = NULL, var4 = NULL), + list(var1 = 3, var2 = "c", var3 = NULL, var4 = NULL) + ) + actual <- transpose(obj) + + expect_equal(actual, expected) +})