File: test-srcrefs.R

package info (click to toggle)
r-cran-testthat 3.3.2-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 4,048 kB
  • sloc: cpp: 9,269; sh: 14; ansic: 14; makefile: 5
file content (85 lines) | stat: -rw-r--r-- 2,491 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
srcref_line <- function(code) {
  srcref <- attr(substitute(code), "srcref")
  if (!is.list(srcref)) {
    stop("code doesn't have srcref", call. = FALSE)
  }

  results <- with_reporter("silent", code)$expectations()
  unlist(lapply(results, function(x) x$srcref[1])) - srcref[[1]][1]
}

test_that("line numbers captured for expectations and warnings", {
  f <- function() warning("Uh oh")
  lines <- srcref_line({
    test_that("simple", {        # line 1
      expect_true(FALSE)         # line 2
      f()                        # line 3
    })
  })
  expect_equal(lines, c(2, 3))
})

test_that("line numbers captured when called indirectly", {
  lines <- srcref_line({
    test_that("simple", {                # line 1
      f <- function() g()                # line 2
      g <- function() h()                # line 3
      h <- function() expect_true(FALSE) # line 4
                                         # line 5
      h()                                # line 6
    })
  })
  expect_equal(lines, 4)

  lines <- srcref_line({
    f <- function() g()                  # line 1
    g <- function() h()                  # line 2
    h <- function() expect_true(FALSE)   # line 3
    test_that("simple", {                # line 4
      h()                                # line 5
    })
  })
  expect_equal(lines, 5)
})

test_that("line numbers captured inside a loop", {
  lines <- srcref_line({
    test_that("simple", {               # line 1
      for (i in 1:4) expect_true(TRUE)  # line 2
    })
  })
  expect_equal(lines, rep(2, 4))
})

test_that("line numbers captured for skip()s and stops()", {
  lines <- srcref_line({
    test_that("simple", {             # line 1
      skip("Not this time")           # line 2
    })                                # line 3
  })
  expect_equal(lines, 2)

  lines <- srcref_line({
    test_that("simple", {             # line 1
      stop("Not this time")           # line 2
    })                                # line 3
  })
  expect_equal(lines, 2)
})

test_that("line numbers captured for on.exit()", {
  lines <- srcref_line({
    test_that("simple", {             # line 1
      on.exit({stop("Error")})        # line 2
    })                                # line 3
  })
  expect_equal(lines, 2)

  # Falls back to test if no srcrf
  lines <- srcref_line({
    test_that("simple", {             # line 1
      on.exit(stop("Error"))          # line 2
    })                                # line 3
  })
  expect_equal(lines, 1)
})