test_that("source_file always uses UTF-8 encoding", {
  has_locale <- function(l) {
    has <- TRUE
    tryCatch(
      withr::with_locale(c(LC_CTYPE = l), "foobar"),
      warning = function(w) has <<- FALSE,
      error = function(e) has <<- FALSE
    )
    has
  }

  ## Some text in UTF-8
  tmp <- tempfile()
  withr::defer(unlink(tmp))
  utf8 <- as.raw(c(
    0xc3,
    0xa1,
    0x72,
    0x76,
    0xc3,
    0xad,
    0x7a,
    0x74,
    0xc5,
    0xb1,
    0x72,
    0xc5,
    0x91,
    0x20,
    0x74,
    0xc3,
    0xbc,
    0x6b,
    0xc3,
    0xb6,
    0x72,
    0x66,
    0xc3,
    0xba,
    0x72,
    0xc3,
    0xb3,
    0x67,
    0xc3,
    0xa9,
    0x70
  ))
  writeBin(c(charToRaw("x <- \""), utf8, charToRaw("\"\n")), tmp)

  run_test <- function(locale) {
    if (has_locale(locale)) {
      env <- new.env()
      withr::with_locale(
        c(LC_CTYPE = locale),
        source_file(tmp, env = env, wrap = FALSE)
      )
      expect_equal(Encoding(env$x), "UTF-8")
      expect_equal(charToRaw(env$x), utf8)
    }
  }

  ## Try to read it in latin1 and UTF-8 locales
  ## They have different names on Unix and Windows
  run_test("en_US.ISO8859-1")
  run_test("en_US.UTF-8")
  run_test("English_United States.1252")
  run_test("German_Germany.1252")
  run_test(Sys.getlocale("LC_CTYPE"))
})

test_that("source_file wraps error", {
  expect_snapshot(error = TRUE, {
    source_file(test_path("reporters/error-setup.R"), wrap = FALSE)
  })
})

test_that("checks its inputs", {
  expect_snapshot(error = TRUE, {
    source_file(1)
    source_file("x")
    source_file(".", "x")
  })
})

# filter_desc -------------------------------------------------------------

test_that("works with all subtest types", {
  code <- exprs(
    test_that("foo", {}),
    describe("bar", {}),
    it("baz", {})
  )
  expect_equal(filter_desc(code, "foo"), code[1])
  expect_equal(filter_desc(code, "bar"), code[2])
  expect_equal(filter_desc(code, "baz"), code[3])
})

test_that("only returns non-subtest code before subtest", {
  code <- exprs(
    f(),
    test_that("bar", {}),
    describe("foo", {}),
    g(),
    h()
  )
  expect_equal(filter_desc(code, "foo"), code[c(1, 3)])
})

test_that("can select recursively", {
  code <- exprs(
    x <- 1,
    describe("a", {
      y <- 1
      describe("b", {
        z <- 1
      })
      y <- 2
    }),
    x <- 2
  )

  expect_equal(
    filter_desc(code, c("a", "b")),
    exprs(
      x <- 1,
      describe("a", {
        y <- 1
        describe("b", {
          z <- 1
        })
      })
    )
  )
})

test_that("works on code like the describe() example", {
  code <- exprs(
    describe("math library", {
      x1 <- 1
      x2 <- 1
      describe("addition()", {
        it("can add two numbers", {
          expect_equal(x1 + x2, addition(x1, x2))
        })
      })
      describe("division()", {
        x1 <- 10
        x2 <- 2
        it("can divide two numbers", {
          expect_equal(x1 / x2, division(x1, x2))
        })
        it("can handle division by 0") #not yet implemented
      })
    })
  )

  expect_equal(
    filter_desc(
      code,
      c("math library", "division()", "can divide two numbers")
    ),
    exprs(
      describe("math library", {
        x1 <- 1
        x2 <- 1
        describe("division()", {
          x1 <- 10
          x2 <- 2
          it("can divide two numbers", {
            expect_equal(x1 / x2, division(x1, x2))
          })
        })
      })
    )
  )

  # what happens for an unimplemented specification?
  expect_snapshot(
    error = TRUE,
    filter_desc(
      code,
      c("math library", "division()", "can handle division by 0")
    )
  )
})

test_that("preserve srcrefs", {
  code <- parse(
    keep.source = TRUE,
    text = '
    test_that("foo", {
      # this is a comment
    })
  '
  )
  expect_snapshot(filter_desc(code, "foo"))
})

test_that("errors if zero or duplicate labels", {
  code <- exprs(
    f(),
    test_that("baz", {}),
    test_that("baz", {}),
    g()
  )

  expect_snapshot(error = TRUE, {
    filter_desc(code, "baz")
    filter_desc(code, "missing")
  })
})

test_that("source_dir()", {
  res <- source_dir("test_dir", pattern = "hello", chdir = TRUE, wrap = FALSE)
  expect_equal(res[[1]](), "Hello World")

  res <- source_dir(
    normalizePath("test_dir"),
    pattern = "hello",
    chdir = TRUE,
    wrap = FALSE
  )
  expect_equal(res[[1]](), "Hello World")

  res <- source_dir("test_dir", pattern = "hello", chdir = FALSE, wrap = FALSE)
  expect_equal(res[[1]](), "Hello World")

  res <- source_dir(
    normalizePath("test_dir"),
    pattern = "hello",
    chdir = FALSE,
    wrap = FALSE
  )
  expect_equal(res[[1]](), "Hello World")
})