tests/testthat/test-inflate-part1.R

In fusen: Build a Package from Rmarkdown Files

# Previously generated by {fusen} from dev/flat_history/flat_history_core.Rmd: now deprecated.
# Test full ----
dummypackage <- tempfile("inflate.tests")
dir.create(dummypackage)

# {fusen} steps
fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
dev_file <- suppressMessages(add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE))
flat_file <- dev_file[grepl("flat_", dev_file)]

usethis::with_project(dummypackage, {
  # More complicated example for tests
  testfile <- "tests-templates/dev-template-tests.Rmd"
  file.copy(
    system.file(testfile, package = "fusen"),
    flat_file,
    overwrite = TRUE
  )
  usethis::use_mit_license("Statnmap")
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file,
      vignette_name = "Get started", check = FALSE,
      open_vignette = FALSE
    )
  )

  test_that("inflate - description is ok", {
    # Description with version
    expect_true(file.exists(file.path(dummypackage, "DESCRIPTION")))
    desc <- desc::desc(file.path(dummypackage, "DESCRIPTION"))
    version_line <- desc$get("Config/fusen/version")
    expect_equal(length(version_line), 1)
    expect_equal(
      as.character(version_line),
      as.character(utils::packageVersion(pkg = "fusen"))
    )
  })

  test_that("inflate - number of files is ok", {
    # Number of files
    expect_equal(length(list.files(file.path(dummypackage, "R"))), 11)
    expect_equal(length(list.files(file.path(dummypackage, "vignettes"))), 1)
    expect_equal(length(list.files(file.path(dummypackage, "tests", "testthat"))), 4)
  })

  my_median_file <- file.path(dummypackage, "R", "my_median.R")
  my_other_median_file <- file.path(dummypackage, "R", "my_other_median.R")
  my_third_median_file <- file.path(dummypackage, "R", "my_third_median.R")
  my_fourth_median_file <- file.path(dummypackage, "R", "my_fourth_median.R")
  my_fifth_median_file <- file.path(dummypackage, "R", "my_fifth_median.R")
  my_sixth_median_file <- file.path(dummypackage, "R", "my-sixth-median_function.R")
  myuppercasefunctionfile <- file.path(dummypackage, "R", "myuppercasefunction.R")
  my_noroxfunctionfile <- file.path(dummypackage, "R", "my_norox.R")
  my_norox2functionfile <- file.path(dummypackage, "R", "my_norox2.R")
  my_spacefunctionfile <- file.path(dummypackage, "R", "my_space.R")
  my_space2functionfile <- file.path(dummypackage, "R", "my_space2.R")

  test_that("inflate - named R files exist", {
    # R files
    expect_true(file.exists(my_median_file))
    expect_true(file.exists(my_other_median_file))
    expect_true(file.exists(my_third_median_file))
    expect_true(file.exists(my_fourth_median_file))
    expect_true(file.exists(my_fifth_median_file))
    expect_true(file.exists(my_sixth_median_file))
    expect_true(file.exists(myuppercasefunctionfile))

    # Found with chunk named `fun`
    expect_true(file.exists(my_noroxfunctionfile))
    # Found with chunk named `fun-norox2`
    expect_true(file.exists(my_norox2functionfile))
    # Found with chunk named `fun_space`
    expect_true(file.exists(my_spacefunctionfile))
    expect_true(file.exists(my_space2functionfile))
  })

  test_that("inflate - R files contents are ok", {
    # examples in R files
    my_median_lines <- readLines(my_median_file)
    expect_equal(my_median_lines[1], "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand")
    expect_true(all(my_median_lines[12:14] == c(
      "#' @examples", "#' my_median(2:20)", "#' my_median(1:12)"
    )))
    my_other_median_lines <- readLines(my_other_median_file)
    expect_equal(my_other_median_lines[1], "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand")
    expect_true(all(my_other_median_lines[12:15] == c(
      "#' @examples", "#' my_other_median(1:12)",
      "#' my_other_median(8:20)", "#' my_other_median(20:50)"
    )))
    my_fourth_median_lines <- readLines(my_fourth_median_file)
    expect_true(all(my_fourth_median_lines[11:13] == c(
      "#' @examples", "#' my_fourth_median(1:12)", "#' my_fourth_median(8:20)"
    )))

    # _no example
    my_third_median_lines <- readLines(my_third_median_file)
    expect_true(all(!grepl("#' @examples", my_third_median_lines)))
    my_fifth_median_lines <- readLines(my_fifth_median_file)
    expect_true(all(!grepl("#' @examples", my_fifth_median_lines)))

    # dot in name
    my_sixth_median_lines <- readLines(my_sixth_median_file)
    expect_true(all(my_sixth_median_lines[11:13] == c(
      "#' @examples", "#' my.sixth.median_function(1:12)", "#' my.sixth.median_function(8:20)"
    )))
    # _no roxygen at all
    my_norox_lines <- readLines(my_noroxfunctionfile)
    expect_true(all(my_norox_lines == c(
      "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", "",
      "#' @noRd", "my_norox <- function(x) {", "  x + 10", "}"
    )))

    # _no roxygen but examples
    my_norox2_lines <- readLines(my_norox2functionfile)
    expect_equal(my_norox2_lines, c(
      "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand", "",
      "#' @noRd", "#' @examples",
      "#' \\dontrun{", "#' # comment",
      "#' my_norox2(10)", "#' }",
      "#'",
      "#' \\dontrun{",
      "#' # comment",
      "#' my_norox2(12)", "#' }",
      "my_norox2 <- function(x) {", "  x + 10", "}"
    ))
    # _extra empty line and examples
    my_space_lines <- readLines(my_spacefunctionfile)
    expect_true(all(my_space_lines[8:12] == c(
      "#' @examples", "#' my_space(10)", "#' @export", "", "my_space <- function(x) {"
    )))
    # _extra empty line and noRd
    my_space2_lines <- readLines(my_space2functionfile)
    expect_true(all(my_space2_lines[8:10] == c(
      "#' @noRd", "", "my_space2 <- function(x) {"
    )))
  })

  test_that("inflate - vignette is ok", {
    # vignette
    the_vignette <- file.path(dummypackage, "vignettes", "get-started.Rmd")
    expect_true(file.exists(the_vignette))
    vignette_lines <- readLines(the_vignette)
    # Do not edit by hand after yaml
    pos.dash <- grep("---", vignette_lines)
    donotedit <- grep(
      "<!-- WARNING - This vignette is generated by \\{fusen\\} from dev/flat_full.Rmd: do not edit by hand -->",
      vignette_lines
    )
    expect_equal(length(donotedit), 1)
    expect_true(pos.dash[2] < donotedit)
    # No dev chunks in the vignette
    expect_false(any(grepl("```{r dev}", vignette_lines, fixed = TRUE)))
    expect_false(any(grepl("```{r development-1", vignette_lines, fixed = TRUE)))
  })

  test_that("inflate - tests files are ok", {
    # tests
    test_file <- file.path(dummypackage, "tests", "testthat", "test-my_median.R")
    expect_true(file.exists(test_file))
    test_lines <- readLines(test_file)
    expect_equal(
      test_lines,
      c(
        "# WARNING - Generated by {fusen} from dev/flat_full.Rmd: do not edit by hand",
        "",
        "test_that(\"my_median works properly and show error if needed\", {",
        "  expect_error(my_median(\"text\"))",
        "})"
      )
    )
    expect_true(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-my_other_median.R")
    ))
    expect_true(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-my-sixth-median_function.R")
    ))
    expect_true(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-myuppercasefunction.R")
    ))
    # no test
    expect_false(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-my_norox.R")
    ))
    expect_false(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-my_space2.R")
    ))
  })

  test_that("inflate - namespace is ok", {
    # Namespace
    expect_true(file.exists(file.path(dummypackage, "NAMESPACE")))
  })
})


# Test package no check errors ----
usethis::with_project(dummypackage, {
  test_that("inflate() output error", {
    # Do not check inside check if on CRAN
    skip_on_os(os = c("windows", "solaris"))

    check_out <- rcmdcheck::rcmdcheck(
      path = ".",
      quiet = TRUE,
      args = c("--no-manual")
    )

    # No errors
    expect_true(length(check_out[["errors"]]) == 0)
    # 1 warning = License => Now a note...
    # expect_true(length(check_out[["warnings"]]) == 1)
    # expect_true(grepl("license", check_out[["warnings"]][1]))
    # No Notes or only one if CRAN ?
    skip_on_cran()
    expect_true(length(check_out[["notes"]]) <= 2)
    if (length(check_out[["notes"]]) %in% 1:2) {
      # if tested as cran
      # 1 note on CRAN for new submission
      print(check_out[["notes"]])

      note_expected <- grepl(
        "New submission|future file timestamps|Package vignette without corresponding tangle output",
        check_out[["notes"]]
      )
      expect_true(all(note_expected))

      if (!all(note_expected)) {
        # Keep here to see the notes when CI fails
        expect_equal(check_out[["notes"]], expected = "no other note")
      }
    } else {
      expect_true(length(check_out[["notes"]]) == 0)
    }
  })
})

# Clean R, tests and vignettes
unlink(file.path(dummypackage, "R"), recursive = TRUE)
unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
unlink(file.path(dummypackage, "tests"), recursive = TRUE)
unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)

# Test no problem with special character in YAML ----
dummypackage.special <- tempfile("dummypackage.special")
dir.create(dummypackage.special)

# {fusen} steps
fill_description(pkg = dummypackage.special, fields = list(Title = "Dummy Package"))
dev_file <- add_flat_template(pkg = dummypackage.special, overwrite = TRUE, open = FALSE)
flat_file <- dev_file[grepl("flat_", dev_file)]

usethis::with_project(dummypackage.special, {
  testfile <- "tests-templates/dev-template-tests-special-char.Rmd"
  file.copy(
    system.file(testfile, package = "fusen"),
    flat_file,
    overwrite = TRUE
  )

  suppressMessages(
    inflate(
      pkg = dummypackage.special, flat_file = flat_file,
      vignette_name = "Get started", check = FALSE,
      open_vignette = FALSE
    )
  )

  test_that("inflate with special yaml worked correctly", {
    # R files
    my_median_file <- file.path(dummypackage.special, "R", "my_median.R")
    expect_true(file.exists(my_median_file))
  })
})

# Test no attachment and no check when asked ----
unlink(file.path(dummypackage, "DESCRIPTION"), recursive = TRUE)
fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
dev_file <- add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE)
flat_file <- dev_file[grepl("flat_", dev_file)]

usethis::with_project(dummypackage, {
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file, vignette_name = "Get started",
      check = FALSE, document = FALSE, open_vignette = FALSE
    )
  )
  desc_lines <- readLines(file.path(dummypackage, "DESCRIPTION"))

  test_that("no attachment run", {
    expect_false("Imports:" %in% desc_lines)
  })

  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)
})

# Tests no errors - no example, no tests ----
usethis::with_project(dummypackage, {
  file.copy(
    system.file("tests-templates/dev-template-no-example-no-tests.Rmd", package = "fusen"),
    flat_file,
    overwrite = TRUE
  )
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file,
      vignette_name = "Get started", check = FALSE,
      open_vignette = FALSE
    )
  )

  test_that("inflate() output no error", {
    expect_true(file.exists(file.path(dummypackage, "vignettes", "get-started.Rmd")))
    expect_true(file.exists(file.path(dummypackage, "R", "my_median.R")))
    expect_true(!file.exists(file.path(dummypackage, "tests", "testthat", "test-my_median.R")))
  })
  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)
})

# Tests no errors - empty ----
usethis::with_project(dummypackage, {
  file.copy(
    system.file("tests-templates/dev-template-test-parse-nothing.Rmd", package = "fusen"),
    flat_file,
    overwrite = TRUE
  )
  test_that("inflate() output message", {
    suppressMessages(
      expect_message(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          vignette_name = "Get started", check = FALSE,
          open_vignette = FALSE
        )
      )
    )
  })
  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)
})

# Tests errors - vignette already exists ----
usethis::with_project(dummypackage, {
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file,
      vignette_name = "Get started",
      check = FALSE, overwrite = "yes",
      open_vignette = FALSE
    )
  )

  test_that("inflate() output error when second time (not interactive)", {
    expect_error(
      suppressMessages(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          vignette_name = "Get started",
          check = FALSE,
          open_vignette = FALSE
        )
      )
    )
    expect_error(
      suppressMessages(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          vignette_name = "Get started",
          check = FALSE, overwrite = "no",
          open_vignette = FALSE
        )
      )
    )
  })

  # No error with overwrite = 'yes'
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file, vignette_name = "Get started",
      check = FALSE, overwrite = "yes", open_vignette = FALSE
    )
  )

  test_that("inflate() output no error", {
    expect_true(file.exists(file.path(dummypackage, "vignettes", "get-started.Rmd")))
  })

  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)
})

# Tests errors - duplicate functions ----
usethis::with_project(dummypackage, {
  file.copy(
    system.file("tests-templates/dev-template-stop-duplicate-fun.Rmd", package = "fusen"),
    flat_file,
    overwrite = TRUE
  )
  test_that("inflate() output error duplicate functions", {
    expect_error(
      suppressMessages(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          vignette_name = "Get started", check = FALSE,
          open_vignette = FALSE
        )
      )
    )
  })
  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)

  # Tests errors - duplicate chunk names
  file.copy(
    system.file("tests-templates/dev-template-stop-duplicate-label.Rmd", package = "fusen"),
    flat_file,
    overwrite = TRUE
  )
  test_that("inflate() - {lightparser} fixes duplicate label names in vignette", {
    expect_error(
      suppressMessages(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          vignette_name = "Get started", check = FALSE,
          open_vignette = FALSE
        )
      ),
      regexp = NA
    )
  })
  # Clean R, tests and vignettes
  unlink(file.path(dummypackage, "R"), recursive = TRUE)
  unlink(file.path(dummypackage, "vignettes"), recursive = TRUE)
  unlink(file.path(dummypackage, "tests"), recursive = TRUE)
  unlink(file.path(dummypackage, "dev", "config_fusen.yaml"), recursive = TRUE)
})

# Test no errors - inflate with .Rproj and no .here ----
usethis::with_project(dummypackage, {
  file.remove(file.path(dummypackage, ".here"))
  file.remove(file.path(dummypackage, ".Rbuildignore"))
  cat("", file = file.path(
    dummypackage,
    paste0(basename(dummypackage), ".Rproj")
  ))

  # Add
  # {fusen} steps
  dev_file <- add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE)
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file,
      vignette_name = "Get started", check = FALSE,
      open_vignette = FALSE
    )
  )

  test_that("add_flat_template inflates with .Rproj and no .here", {
    expect_true(file.exists(flat_file))
    expect_false(file.exists(file.path(dummypackage, ".here")))

    rbuildignore_file <- file.path(dummypackage, ".Rbuildignore")
    expect_true(file.exists(rbuildignore_file))
    rbuildignore_lines <- readLines(rbuildignore_file)
    expect_true(any(grepl("dev", rbuildignore_lines, fixed = TRUE)))
    expect_false(any(grepl("[.]here", rbuildignore_lines)))

    # R files
    my_median_file <- file.path(dummypackage, "R", "my_median.R")
    expect_true(file.exists(my_median_file))
    # vignette
    expect_true(file.exists(file.path(dummypackage, "vignettes", "get-started.Rmd")))
    # tests
    expect_true(file.exists(
      file.path(dummypackage, "tests", "testthat", "test-my_median.R")
    ))
  })
})
# Delete dummy package
unlink(dummypackage, recursive = TRUE)

# Test no errors - clean vignette_name for vignette ----
# Create a new project
dummypackage <- tempfile("clean.vignette")
dir.create(dummypackage)

# {fusen} steps
fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
dev_file <- suppressMessages(add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE))
flat_file <- dev_file[grepl("flat_", dev_file)]

usethis::with_project(dummypackage, {
  suppressMessages(
    inflate(
      pkg = dummypackage, flat_file = flat_file,
      vignette_name = "# y \\  _ p n@ \u00E9 ! 1", check = FALSE,
      open_vignette = FALSE
    )
  )

  # Vignette name is also cleaned by {usethis} for special characters
  vignette_path <- file.path(dummypackage, "vignettes", "y-p-n-e-1.Rmd")

  test_that("vignette is created with clean vignette_name", {
    expect_true(file.exists(vignette_path))
    # usethis::use_vignette writes in UTF-8
    vig_lines <- readLines(vignette_path, encoding = "UTF-8")
    expect_true(sum(grepl(enc2utf8("# y -  _ p n@ \u00E9 ! 1"), vig_lines, fixed = TRUE)) == 2)
    expect_equal(vig_lines[2], enc2utf8('title: "# y -  _ p n@ \u00E9 ! 1"'))
    expect_equal(vig_lines[5], enc2utf8("  %\\VignetteIndexEntry{# y -  _ p n@ \u00E9 ! 1}"))
  })
})
# Delete dummy package
unlink(dummypackage, recursive = TRUE)


# Test stop when no DESCRIPTION file ----
dummypackage <- tempfile("descpackage")
dir.create(dummypackage)
dev_file <- add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE)
flat_file <- dev_file[grepl("flat_", dev_file)]

usethis::with_project(dummypackage, {
  test_that("stop when no DESCRIPTION file", {
    expect_error(
      suppressMessages(
        inflate(
          pkg = dummypackage, flat_file = flat_file,
          check = FALSE, open_vignette = FALSE
        )
      ),
      "DESCRIPTION file"
    )
  })
})

# Delete dummy package
unlink(dummypackage, recursive = TRUE)
if (exists("dummypackage.special")) {
  unlink(dummypackage.special, recursive = TRUE)
}

# Inflate fails or not if no flat_file ----
test_that("inflate fails without flat file", {
  expect_error(inflate(overwrite = FALSE), regexp = "directly in the console")
})

dummypackage <- tempfile("flatfile.empty")
dir.create(dummypackage)

# {fusen} steps
fill_description(pkg = dummypackage, fields = list(Title = "Dummy Package"))
dev_file <- suppressMessages(add_flat_template(pkg = dummypackage, overwrite = TRUE, open = FALSE))
flat_file <- dev_file[grepl("flat_", dev_file)]

# If interactive in RStudio
if (
  requireNamespace("rstudioapi") &&
    rstudioapi::isAvailable() &&
    rstudioapi::hasFun("navigateToFile") &&
    rstudioapi::hasFun("documentId") &&
    rstudioapi::hasFun("documentClose")
) {
  print("Test with RStudio")
  # current position
  curr_editor <- rstudioapi::getSourceEditorContext()
  curr_position <- curr_editor$selection[[1L]]$range$start
  # Change file
  rstudioapi::navigateToFile(flat_file)
  Sys.sleep(1)
  id <- rstudioapi::documentId()

  usethis::with_project(dummypackage, {
    test_that("inflate works without flat file when current is Rmd", {
      expect_message(
        inflate(
          pkg = dummypackage, # flat_file = flat_file,
          vignette_name = "Get started", check = FALSE,
          open_vignette = FALSE, overwrite = TRUE
        ),
        regexp = "The current file will be inflated"
      )
    })
  })

  # # Back to current position
  rstudioapi::navigateToFile(curr_editor$path, line = curr_position[1])

  if (rstudioapi::hasFun("documentClose")) {
    rstudioapi::documentClose(id)
  }
}