From 21fb7959a5397bcbcbbaeebb3073aba5ebf00238 Mon Sep 17 00:00:00 2001
From: Winston Chang <winston@stdout.org>
Date: Fri, 1 Aug 2014 16:11:51 -0500
Subject: [PATCH] Fix edge case with nested choices. Fixes #560

When the set of choices is a list containing a named vector of length 1,
choicesWithNames would return the wrong result.
---
 R/bootstrap.R               | 2 +-
 inst/tests/test-bootstrap.r | 5 +++++
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/R/bootstrap.R b/R/bootstrap.R
index 14161b3c3..fd57290f4 100644
--- a/R/bootstrap.R
+++ b/R/bootstrap.R
@@ -681,7 +681,7 @@ choicesWithNames <- function(choices) {
     res <- lapply(obj, function(val) {
       if (is.list(val))
         listify(val)
-      else if (length(val) == 1)
+      else if (length(val) == 1 && is.null(names(val)))
         val
       else
         makeNamed(as.list(val))
diff --git a/inst/tests/test-bootstrap.r b/inst/tests/test-bootstrap.r
index fc07ad8ea..07af9381d 100644
--- a/inst/tests/test-bootstrap.r
+++ b/inst/tests/test-bootstrap.r
@@ -76,6 +76,11 @@ test_that("Choices are correctly assigned names", {
     choicesWithNames(list(A="a", B="b", C=list("d", "e"))),
     list(A="a", B="b", C=list(d="d", e="e"))
   )
+  # List, named, with a named sub-vector of length 1
+  expect_identical(
+    choicesWithNames(list(A="a", B="b", C=c(D="d"))),
+    list(A="a", B="b", C=list(D="d"))
+  )
   # List, some named, with sublist
   expect_identical(
     choicesWithNames(list(A="a", "b", C=list("d", E="e"))),