tests: uncomment property tests for str_dup()

etiennebacher · Oct 9, 2024 · 94d84b9 · 94d84b9
1 parent e91647b
commit 94d84b9
Show file tree

Hide file tree

Showing 4 changed files with 106 additions and 98 deletions.
diff --git a/R/funs-string.R b/R/funs-string.R
@@ -41,9 +41,11 @@ pl_str_dup_stringr <- function(string, times) {
     times <- pl$lit(times)
   }
   pl$
-    when(times$is_null())$
+    when(times$is_null() | string$is_null())$
     then(pl$lit(NA))$
-    otherwise(string$repeat_by(times)$list$join(""))
+    when(times == pl$lit(0))$
+    then(pl$lit(""))$
+    otherwise(string$cast(pl$String)$repeat_by(times)$list$join(""))
 }
 
 # TODO: this requires https://github.com/pola-rs/polars/issues/11455
@@ -102,14 +104,14 @@ pl_str_pad_stringr <- function(string, width, side = "left", pad = " ", use_widt
 
   if (isFALSE(use_width)) {
     abort(
-      '`str_pad()` doesn\'t work in a Polars DataFrame when `use_width = FALSE`',
+      "`str_pad()` doesn't work in a Polars DataFrame when `use_width = FALSE`",
       class = "tidypolars_error"
     )
   }
 
   if (length(width) > 1) {
     abort(
-      '`str_pad()` doesn\'t work in a Polars DataFrame when `width` has a length greater than 1.',
+      "`str_pad()` doesn't work in a Polars DataFrame when `width` has a length greater than 1.",
       class = "tidypolars_error"
     )
   }
@@ -122,8 +124,7 @@ pl_str_pad_stringr <- function(string, width, side = "left", pad = " ", use_widt
     return(string)
   }
 
-  switch(
-    side,
+  switch(side,
     "both" = abort(
       '`str_pad()` doesn\'t work in a Polars DataFrame when `side = "both"`',
       class = "tidypolars_error"
@@ -279,8 +280,7 @@ pl_str_trim_stringr <- function(string, side = "both", ...) {
   check_empty_dots(...)
   side <- polars_expr_to_r(side)
 
-  switch(
-    side,
+  switch(side,
     "both" = string$str$strip_chars(),
     "left" = string$str$strip_chars_start(),
     "right" = string$str$strip_chars_end()
@@ -296,8 +296,7 @@ pl_str_trunc_stringr <- function(string, width, side = "right", ellipsis = "..."
   if (width < nchar(ellipsis)) {
     abort(paste0("`width` (", width, ") is shorter than `ellipsis` (", nchar(ellipsis), ")."))
   }
-  switch(
-    side,
+  switch(side,
     "left" = pl$concat_str(pl$lit(ellipsis), string$str$tail(width - nchar(ellipsis))),
     "right" = pl$concat_str(string$str$head(width - nchar(ellipsis)), pl$lit(ellipsis)),
     "center" = abort("`side = \"center\" is not supported.`"),

diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -8,25 +8,28 @@ library(tools)
 lf <- list.files(test_path(), pattern = "^test")
 eager <- lf[grep("lazy", lf, invert = TRUE)]
 
-exceptions <- c("test-benchmark.R", "test-compute.R", "test-collect.R",
-                "test-describe.R", "test-fetch.R",
-                "test-group_split.R",
-                "test-pivot_wider.R", "test-sink_csv.R",
-                "test-sink.R", "test-summary.R", "test-utils.R",
-                "test-write.R")
+exceptions <- c(
+  "test-benchmark.R", "test-compute.R", "test-collect.R",
+  "test-describe.R", "test-fetch.R",
+  "test-group_split.R",
+  "test-pivot_wider.R", "test-sink_csv.R",
+  "test-sink.R", "test-summary.R", "test-utils.R",
+  "test-write.R"
+)
 
 eager <- setdiff(eager, exceptions)
 
 for (i in eager) {
   tmp <- readLines(test_path(i))
   out <- gsub("pl\\$DataFrame", "pl\\$LazyFrame", tmp)
-  out <- gsub("expect_equal", "expect_equal_lazy", out)
-  out <- gsub("expect_error", "expect_error_lazy", out)
+  out <- gsub("expect_equal\\(", "expect_equal_lazy(", out)
+  out <- gsub("expect_error\\(", "expect_error_lazy(", out)
   out <- gsub("expect_snapshot", "expect_snapshot_lazy", out)
-  out <- paste0("### [GENERATED AUTOMATICALLY] Update ", i, " instead.\n\n",
-                "Sys.setenv('TIDYPOLARS_TEST' = TRUE)\n\n",
-                paste(out, collapse = "\n"),
-                "\n\nSys.setenv('TIDYPOLARS_TEST' = FALSE)")
+  out <- paste0(
+    "### [GENERATED AUTOMATICALLY] Update ", i, " instead.\n\n",
+    "Sys.setenv('TIDYPOLARS_TEST' = TRUE)\n\n",
+    paste(out, collapse = "\n"),
+    "\n\nSys.setenv('TIDYPOLARS_TEST' = FALSE)"
+  )
   cat(out, file = test_path(gsub("\\.R$", "-lazy\\.R", i)))
 }
-
diff --git a/tests/testthat/test-funs-string-lazy.R b/tests/testthat/test-funs-string-lazy.R
@@ -44,24 +44,27 @@ Sys.setenv('TIDYPOLARS_TEST' = TRUE)
 #   )
 # })
 
-patrick::with_parameters_test_that("several non-regex functions work", {
-  for_all(
-    tests = 40,
-    string = character_(any_na = TRUE),
-    property = function(string) {
-      test_df <- data.frame(x1 = string)
-      test <- pl$LazyFrame(x1 = string)
-
-      pl_code <- paste0("mutate(test, foo = ", fun, "(string)) |> pull(foo)")
-      tv_code <- paste0("mutate(test_df, foo = ", fun, "(string)) |> pull(foo)")
-
-      expect_equal_lazy(
-        eval(parse(text = pl_code)),
-        eval(parse(text = tv_code)),
-      )
-    }
-  )
-}, fun = c("str_to_upper", "str_to_lower", "str_length", "str_squish"))
+patrick::with_parameters_test_that("several non-regex functions work",
+  {
+    for_all(
+      tests = 40,
+      string = character_(any_na = TRUE),
+      property = function(string) {
+        test_df <- data.frame(x1 = string)
+        test <- pl$LazyFrame(x1 = string)
+
+        pl_code <- paste0("mutate(test, foo = ", fun, "(string)) |> pull(foo)")
+        tv_code <- paste0("mutate(test_df, foo = ", fun, "(string)) |> pull(foo)")
+
+        expect_equal_lazy(
+          eval(parse(text = pl_code)),
+          eval(parse(text = tv_code)),
+        )
+      }
+    )
+  },
+  fun = c("str_to_upper", "str_to_lower", "str_length", "str_squish")
+)
 
 
 test_that("str_trim() works", {
@@ -114,7 +117,7 @@ test_that("str_trim() works", {
 #           "doesn't work in a Polars DataFrame when `width` has a length greater than 1"
 #         )
 #       } else {
-#         expect_equal_lazy_or_both_error(
+#         expect_equal_or_both_error(
 #           mutate(test, foo = str_pad(x1, side = side, pad = pad, width = width)) |>
 #             pull(foo),
 #           mutate(test_df, foo = str_pad(x1, side = side, pad = pad, width = width)) |>
@@ -125,33 +128,33 @@ test_that("str_trim() works", {
 #   )
 # })
 
-# test_that("str_dup() works", {
-#   for_all(
-#     tests = 40,
-#     string = character_(any_na = TRUE),
-#     # Very high numbers crash the session, I guess because of stringr
-#     times = numeric_bounded(-10000, 10000, any_na = TRUE),
-#     property = function(string, times) {
-#       test_df <- data.frame(x1 = string)
-#       test <- pl$LazyFrame(x1 = string)
-#
-#       expect_equal_lazy_or_both_error(
-#         mutate(test, foo = str_dup(x1, times = times)) |>
-#           pull(foo),
-#         mutate(test_df, foo = str_dup(x1, times = times)) |>
-#           pull(foo)
-#       )
-#     }
-#   )
-# })
+test_that("str_dup() works", {
+  for_all(
+    tests = 100,
+    string = character_(any_na = TRUE),
+    # Very high numbers crash the session, I guess because of stringr
+    times = numeric_bounded(-10000, 10000, any_na = TRUE),
+    property = function(string, times) {
+      test_df <- data.frame(x1 = string)
+      test <- pl$LazyFrame(x1 = string)
+
+      expect_equal_or_both_error(
+        mutate(test, foo = str_dup(x1, times = times)) |>
+          pull(foo),
+        mutate(test_df, foo = str_dup(x1, times = times)) |>
+          pull(foo)
+      )
+    }
+  )
+})
 
 # string = c("B#co4Nq,q", "B#co4Nq,q", "B#co4Nq,q", NA, NA, "B#co4Nq,q", NA)
 # start = -999
 # end = c(0, 0, 0, NA, 0, NA, NA)
 # test_df <- data.frame(x1 = string)
 # test <- pl$LazyFrame(x1 = string)
 #
-# expect_equal_lazy_or_both_error(
+# expect_equal_or_both_error(
 #   mutate(test, foo = str_sub(x1, start, end)) |>
 #     pull(foo),
 #   mutate(test_df, foo = str_sub(x1, start, end)) |>
@@ -168,7 +171,7 @@ test_that("str_trim() works", {
 #       test_df <- data.frame(x1 = string)
 #       test <- pl$LazyFrame(x1 = string)
 #
-#       expect_equal_lazy_or_both_error(
+#       expect_equal_or_both_error(
 #         mutate(test, foo = str_sub(x1, start, end)) |>
 #           pull(foo),
 #         mutate(test_df, foo = str_sub(x1, start, end)) |>

diff --git a/tests/testthat/test-funs-string.R b/tests/testthat/test-funs-string.R
@@ -40,24 +40,27 @@
 #   )
 # })
 
-patrick::with_parameters_test_that("several non-regex functions work", {
-  for_all(
-    tests = 40,
-    string = character_(any_na = TRUE),
-    property = function(string) {
-      test_df <- data.frame(x1 = string)
-      test <- pl$DataFrame(x1 = string)
+patrick::with_parameters_test_that("several non-regex functions work",
+  {
+    for_all(
+      tests = 40,
+      string = character_(any_na = TRUE),
+      property = function(string) {
+        test_df <- data.frame(x1 = string)
+        test <- pl$DataFrame(x1 = string)
 
-      pl_code <- paste0("mutate(test, foo = ", fun, "(string)) |> pull(foo)")
-      tv_code <- paste0("mutate(test_df, foo = ", fun, "(string)) |> pull(foo)")
+        pl_code <- paste0("mutate(test, foo = ", fun, "(string)) |> pull(foo)")
+        tv_code <- paste0("mutate(test_df, foo = ", fun, "(string)) |> pull(foo)")
 
-      expect_equal(
-        eval(parse(text = pl_code)),
-        eval(parse(text = tv_code)),
-      )
-    }
-  )
-}, fun = c("str_to_upper", "str_to_lower", "str_length", "str_squish"))
+        expect_equal(
+          eval(parse(text = pl_code)),
+          eval(parse(text = tv_code)),
+        )
+      }
+    )
+  },
+  fun = c("str_to_upper", "str_to_lower", "str_length", "str_squish")
+)
 
 
 test_that("str_trim() works", {
@@ -121,25 +124,25 @@ test_that("str_trim() works", {
 #   )
 # })
 
-# test_that("str_dup() works", {
-#   for_all(
-#     tests = 40,
-#     string = character_(any_na = TRUE),
-#     # Very high numbers crash the session, I guess because of stringr
-#     times = numeric_bounded(-10000, 10000, any_na = TRUE),
-#     property = function(string, times) {
-#       test_df <- data.frame(x1 = string)
-#       test <- pl$DataFrame(x1 = string)
-#
-#       expect_equal_or_both_error(
-#         mutate(test, foo = str_dup(x1, times = times)) |>
-#           pull(foo),
-#         mutate(test_df, foo = str_dup(x1, times = times)) |>
-#           pull(foo)
-#       )
-#     }
-#   )
-# })
+test_that("str_dup() works", {
+  for_all(
+    tests = 100,
+    string = character_(any_na = TRUE),
+    # Very high numbers crash the session, I guess because of stringr
+    times = numeric_bounded(-10000, 10000, any_na = TRUE),
+    property = function(string, times) {
+      test_df <- data.frame(x1 = string)
+      test <- pl$DataFrame(x1 = string)
+
+      expect_equal_or_both_error(
+        mutate(test, foo = str_dup(x1, times = times)) |>
+          pull(foo),
+        mutate(test_df, foo = str_dup(x1, times = times)) |>
+          pull(foo)
+      )
+    }
+  )
+})
 
 # string = c("B#co4Nq,q", "B#co4Nq,q", "B#co4Nq,q", NA, NA, "B#co4Nq,q", NA)
 # start = -999