diff --git a/DESCRIPTION b/DESCRIPTION index 9bbf056..e2deb1a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,11 +10,10 @@ Authors@R: c( comment = c(ORCID = "0000-0003-4470-8361")), person("Poisson Consulting", role = c("cph", "fnd")) ) -Description: Tracks elapsed clock time using a `hms::hms()` scalar, which - if running has an attribute named start that specifies the system time - when the timer was started. The elapsed time is the value of the - scalar plus the difference between the current system time and the - system time when the timer was started. +Description: Tracks elapsed clock time using a `hms::hms()` scalar. + It was was originally developed to time Bayesian model runs. + It should not be used to estimate how long extremely fast code takes to execute + as the package code adds a small time cost. License: MIT + file LICENSE URL: https://github.com/poissonconsulting/hmstimer, https://poissonconsulting.github.io/hmstimer/ diff --git a/NAMESPACE b/NAMESPACE index 3fb7ef2..2ed57cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export("tmr_title<-") export(local_timer) export(tmr_ceiling) export(tmr_elapsed) @@ -7,12 +8,14 @@ export(tmr_floor) export(tmr_format) export(tmr_is_started) export(tmr_is_stopped) +export(tmr_is_titled) export(tmr_print) export(tmr_reset) export(tmr_round) export(tmr_start) export(tmr_stop) export(tmr_timer) +export(tmr_title) export(with_timer) import(hms) importFrom(lifecycle,deprecated) diff --git a/R/ceiling.R b/R/ceiling.R index c1f6ead..2bbb1a3 100644 --- a/R/ceiling.R +++ b/R/ceiling.R @@ -11,6 +11,7 @@ #' tmr_ceiling(tmr_timer(122.1)) tmr_ceiling <- function(x) { start <- tmr_is_started(x) + title <- tmr_title(x) x <- ceiling(as.numeric(tmr_elapsed(x))) - tmr_timer(x, start = start) + tmr_timer(x, start = start, title = title) } diff --git a/R/chk.R b/R/chk.R index 2cea2e3..b6c7421 100644 --- a/R/chk.R +++ b/R/chk.R @@ -25,21 +25,34 @@ chk_seconds <- function(seconds) { err("`seconds` must not be a missing value.") } -chk_start <- function(start) { - if (is.logical(start) && length(start) == 1L && !is.na(start)) { +chk_title <- function(title) { + if (is.null(title) || (is.character(title) && length(title) == 1L && !is.na(title))) { + return(invisible()) + } + if (!is.character(title)) err("`title` must be numeric.") + if (length(title) != 1L) err("`title` must be a scalar.") + err("`title` must not be a missing value.") +} + +chk_flag <- function(x, name) { + if (is.logical(x) && length(x) == 1L && !is.na(x)) { return(invisible()) } - if (!is.logical(start)) err("`start` must be class logical.") - if (length(start) != 1L) err("`start` must be a scalar.") - err("`start` must not be a missing value.") + if (!is.logical(x)) err("`", name, "` must be class logical.") + if (length(x) != 1L) err("`", name, "` must be a scalar.") + err("`", name, "` must not be a missing value.") +} + +chk_start <- function(start) { + chk_flag(start, "start") } chk_x <- function(x) { - if (is.hms(x) && length(x) == 1L && !is.na(x)) { + if (is_hms(x) && length(x) == 1L && !is.na(x)) { return(invisible()) } - if (!is.hms(x)) err("`x` must be class hms.") + if (!is_hms(x)) err("`x` must be class hms.") if (length(x) != 1L) err("`x` must be a scalar.") err("`x` must not be a missing value.") } diff --git a/R/floor.R b/R/floor.R index f947cc5..c2b99bc 100644 --- a/R/floor.R +++ b/R/floor.R @@ -11,6 +11,7 @@ #' tmr_floor(tmr_timer(122.1)) tmr_floor <- function(x) { start <- tmr_is_started(x) + title <- tmr_title(x) x <- floor(as.numeric(tmr_elapsed(x))) - tmr_timer(x, start = start) + tmr_timer(x, start = start, title = title) } diff --git a/R/format.R b/R/format.R index 06f0c6e..f237046 100644 --- a/R/format.R +++ b/R/format.R @@ -12,15 +12,22 @@ #' @examples #' tmr_format(tmr_timer(61.66)) #' tmr_format(tmr_timer(61.66), digits = 0) -tmr_format <- function(x, digits = 3) { +tmr_format <- function(x, digits = 3, ..., print_title = TRUE) { chk_digits(digits) + rlang::check_dots_empty() + if (digits < 0) err("`digits` must not be negative.") x <- tmr_round(x, digits = digits) msecs <- as.numeric(x) - floor(as.numeric(x)) x <- tmr_floor(x) + title <- tmr_title(x) x <- as.character(x) msecs <- formatC(msecs, digits = digits, format = "f") msecs <- substr(msecs, 2, nchar(msecs)) - paste0(x, msecs) + x <- paste0(x, msecs) + if (print_title) { + x <- paste_title(x, title) + } + x } diff --git a/R/internal.R b/R/internal.R deleted file mode 100644 index fa337f1..0000000 --- a/R/internal.R +++ /dev/null @@ -1,5 +0,0 @@ -as_hms <- function(x) { - x <- as.difftime(x, units = "secs") - class(x) <- c("hms", "difftime") - x -} diff --git a/R/is-titled.R b/R/is-titled.R new file mode 100644 index 0000000..c4bedfb --- /dev/null +++ b/R/is-titled.R @@ -0,0 +1,13 @@ +#' Is hms Timer Title +#' +#' Tests if a [hms_timer()] has a title (as indicated by the +#' presence of an attribute named start). +#' @inheritParams params +#' @return A flag (TRUE or FALSE). +#' @export +#' @examples +#' tmr_is_titled(tmr_timer()) +#' tmr_is_titled(tmr_timer(title = "my timer")) +tmr_is_titled <- function(x) { + tmr_title(x) != "" +} diff --git a/R/local-timer.R b/R/local-timer.R index 0985b91..6d708ab 100644 --- a/R/local-timer.R +++ b/R/local-timer.R @@ -15,12 +15,28 @@ #' 10 #' } #' fun() -local_timer <- function(.local_envir = rlang::caller_env()) { +local_timer <- function(..., title = "", srcref = TRUE, .local_envir = rlang::caller_env()) { + rlang::check_dots_empty() + chk_title(title) chk_env(.local_envir) + chk_flag(srcref, "srcref") rlang::check_installed("withr", reason = "to create a local_timer().") - tmr <- tmr_start(as_hms(0)) + + if (srcref) { + caller <- sys.call() + srcref <- utils::getSrcref(caller) + file <- utils::getSrcFilename(srcref) + file_line <- paste0(file, ":", srcref[[1]]) + + if (!is.null(title) && title != "") { + file_line <- paste0(file_line, " - ", title) + } + } else { + file_line <- title + } + tmr <- tmr_start(as_hms(0), title = file_line) withr::defer(message(tmr_format(tmr)), envir = .local_envir) invisible(tmr) } diff --git a/R/params.R b/R/params.R index f18dd3e..912d8b0 100644 --- a/R/params.R +++ b/R/params.R @@ -1,11 +1,29 @@ -#' Parameter Descriptions for hmstimer Functions +#' Parameter Descriptions #' -#' @param .local_envir The environment to use for scoping. -#' @param code Code to time. -#' @param digits A whole number of the number of decimal places. +#' Default parameter descriptions which may be overridden in individual +#' functions. +#' +#' A flag is a non-missing logical scalar. +#' +#' A string is a non-missing character scalar. +#' +#' A count is a non-missing non-negative integer scalar or double +#' scalar with no fractional part. +# +#' @param code A line or block of R code. +#' @param digits A count of the number of decimal places. +#' @param print_title A flag specifying whether to print the title. #' @param seconds A non-negative numeric scalar of the initial number of seconds. -#' @param start A flag indicating whether to start the timer. +#' @param srcref A flag specifying whether to print the source reference. +#' @param start A flag specifying whether to start the timer. +#' @param title A string of the title. +#' @param value A string of the title. #' @param x A [hms_timer()]. +#' @param .local_envir The environment to use for scoping. +#' @inheritParams rlang::args_dots_empty #' @keywords internal -#' @name params -NULL +#' @aliases parameters arguments args +#' @usage NULL +# nocov start +params <- function(...) NULL +# nocov end diff --git a/R/print.R b/R/print.R index 8d3574c..dc815a3 100644 --- a/R/print.R +++ b/R/print.R @@ -13,10 +13,17 @@ #' @examples #' x <- tmr_start(tmr_timer()) #' tmr_print(x) -tmr_print <- function(x) { +tmr_print <- function(x, ..., print_title = TRUE) { chk_x(x) + rlang::check_dots_empty() + chk_flag(print_title, "print_title") + if (!tmr_is_started(x)) { - print(x) + time <- format(x) + if (print_title) { + time <- paste_title(time, tmr_title(x)) + } + print(time) return(invisible(x)) } @@ -29,6 +36,9 @@ tmr_print <- function(x) { sys_time <- format(structure(sys_time, class = "POSIXct", tzone = "UTC"), "%T") time_passed <- paste(start, " (+", time_passed, " => ", sys_time, ")", sep = "") + if (print_title) { + time_passed <- paste_title(time_passed, tmr_title(x)) + } print(time_passed) return(invisible(x)) } diff --git a/R/reset.R b/R/reset.R index 495ab95..2c71dca 100644 --- a/R/reset.R +++ b/R/reset.R @@ -12,5 +12,6 @@ #' tmr_reset(tmr) tmr_reset <- function(x, seconds = 0) { start <- tmr_is_started(x) - tmr_timer(seconds = seconds, start = start) + title <- tmr_title(x) + tmr_timer(seconds = seconds, start = start, title = title) } diff --git a/R/round.R b/R/round.R index 0ed06b0..661e02b 100644 --- a/R/round.R +++ b/R/round.R @@ -15,6 +15,7 @@ #' tmr_round(tmr_timer(121), -2) # 121 is rounded to 100 seconds tmr_round <- function(x, digits = 0) { start <- tmr_is_started(x) + title <- tmr_title(x) x <- round(as.numeric(tmr_elapsed(x)), digits = digits) - tmr_timer(x, start = start) + tmr_timer(x, start = start, title = title) } diff --git a/R/start.R b/R/start.R index cbaaa82..e1b3105 100644 --- a/R/start.R +++ b/R/start.R @@ -14,11 +14,16 @@ #' print(tmr_elapsed(tmr)) #' Sys.sleep(0.01) #' print(tmr_elapsed(tmr)) -tmr_start <- function(x) { +tmr_start <- function(x, ..., title = NULL) { + rlang::check_dots_empty() + chk_title(title) if (tmr_is_started(x)) { wrn("`x` is already started.") return(x) } attr(x, "start") <- as.double(Sys.time()) + if (!tmr_is_titled(x) && !is.null(title)) { + tmr_title(x) <- title + } x } diff --git a/R/stop.R b/R/stop.R index abca4b7..2709a9e 100644 --- a/R/stop.R +++ b/R/stop.R @@ -18,7 +18,9 @@ tmr_stop <- function(x) { wrn("`x` is already stopped.") return(x) } + title <- tmr_title(x) x <- tmr_elapsed(x) attr(x, "start") <- NULL + tmr_title(x) <- title x } diff --git a/R/timer.R b/R/timer.R index 0ff590c..877fee0 100644 --- a/R/timer.R +++ b/R/timer.R @@ -7,16 +7,20 @@ #' @export #' #' @examples -#' tmr <- tmr_timer() -#' print(tmr) -#' class(tmr) -tmr_timer <- function(seconds = 0, start = FALSE) { +#' tmr_timer() +#' tmr_timer(1, start = TRUE, title = "my timer") +#' class(tmr_timer(2)) +#' str(tmr_timer(2, start = TRUE, title = "a timer")) +tmr_timer <- function(seconds = 0, start = FALSE, ..., title = "") { chk_seconds(seconds) chk_start(start) + rlang::check_dots_empty() + chk_title(title) seconds <- as.double(seconds) x <- as_hms(seconds) + attr(x, "title") <- unname(title) if (start) x <- tmr_start(x) x } diff --git a/R/title.R b/R/title.R new file mode 100644 index 0000000..7609ac3 --- /dev/null +++ b/R/title.R @@ -0,0 +1,41 @@ +#' Get Title hms Timer +#' +#' Returns a flag (character vector) of the title. +#' +#' @inheritParams params +#' @return A flag of the title. +#' @seealso [tmr_title<-()] +#' @export +#' @examples +#' tmr_title(tmr_timer()) +#' tmr_title(tmr_timer(title = "")) +#' tmr_title(tmr_timer(title = "A Title")) +tmr_title <- function(x) { + title <- attr(x, "title") + if (is.null(title)) { + return("") + } + unname(title) +} + +#' Set Title hms Timer +#' +#' Sets the title of a [hms_timer()]. +#' +#' @inheritParams params +#' @return A copy of the [hms_timer()] with the new title. +#' @seealso [tmr_title()] +#' @export +#' @examples +#' tmr <- tmr_timer(title = "A title") +#' tmr_print(tmr) +#' tmr_title(tmr) <- "A different title" +#' tmr_print(tmr) +#' tmr_title(tmr) <- NULL +#' tmr_print(tmr) +`tmr_title<-` <- function(x, value) { + chk_title(value) + value <- unname(value) + attr(x, "title") <- value + x +} diff --git a/R/utils.R b/R/utils.R index 584cd8e..cc0bceb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,14 @@ -is.hms <- function(x) inherits(x, "hms") +as_hms <- function(x) { + hms::new_hms(x) +} err <- function(...) stop(..., call. = FALSE) wrn <- function(...) warning(..., call. = FALSE) + +paste_title <- function(x, title) { + if (is.null(title) || !nchar(title)) { + return(x) + } + paste0(x, " [", title, "]") +} diff --git a/R/with-timer.R b/R/with-timer.R index 2480351..78047d4 100644 --- a/R/with-timer.R +++ b/R/with-timer.R @@ -1,6 +1,7 @@ #' With Timer #' #' @inheritParams params +#' @param title A flag specifying whether to add a title based on code. #' #' @return The result of executing the code. #' @seealso [local_timer()] @@ -19,7 +20,15 @@ #' } #' 20 #' }) -with_timer <- function(code) { - local_timer() +with_timer <- function(code, ..., title = FALSE, srcref = FALSE) { + rlang::check_dots_empty() + chk_flag(title) + + if (title) { + title <- rlang::expr_label(rlang::enexpr(code)) + } else { + title <- "" + } + local_timer(title = title, srcref = srcref) force(code) } diff --git a/README.Rmd b/README.Rmd index 2ddc825..654057e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -25,29 +25,73 @@ knitr::opts_chunk$set( `hmstimer` is an R package to -track elapsed clock time using a [hms::hms](https://github.com/tidyverse/hms) scalar, which if running has an attribute named start that specifies the system time when the timer was started. +track elapsed clock time using a [hms::hms](https://github.com/tidyverse/hms) scalar. -The elapsed time is the value of the scalar plus the difference between the current system time and the system time when the timer was started. +`hmstimer` was originally developed to time Bayesian model runs. It should not be used to estimate how long extremely fast code takes to execute as the package code adds a small time cost. + +Create and start a timer with `tmr_timer(start = TRUE)`. ```{r} library(hmstimer) -tmr <- tmr_timer(seconds = 125, start = TRUE) -tmr +tmr <- tmr_timer(start = TRUE) +Sys.sleep(0.1) +str(tmr) +hms::as_hms(tmr) +``` + +Get the elapsed time with `tmr_elapsed()`. +The title is optional. +```{r} +tmr <- tmr_timer(start = TRUE, title = "my timer") + +Sys.sleep(0.1) tmr_elapsed(tmr) -tmr + +Sys.sleep(0.1) tmr_elapsed(tmr) +``` +Stop the timer with `tmr_stop()`. + +```{r} tmr <- tmr_stop(tmr) +tmr_elapsed(tmr) + +Sys.sleep(1) +tmr_elapsed(tmr) +``` -tmr +Restart the timer with `tmr_start()`. +```{r} +tmr <- tmr_start(tmr) +tmr_elapsed(tmr) +Sys.sleep(0.1) tmr_elapsed(tmr) +``` + +There are several options for printing and formatting including coercing to a hms object. +```{r} +tmr <- tmr_stop(tmr) +print(tmr) +tmr_print(tmr) +tmr_format(tmr, digits = 5) +``` -tmr_format(tmr, digits = 4) +If running `tmr_print()` behaves differently. +```{r} +tmr <- tmr_start(tmr) +tmr_print(tmr) +``` + +The time for a block of code to complete can be printed using `with_timer()`. + +```{r} with_timer({ - Sys.sleep(1) - 1 + Sys.sleep(0.1) + Sys.sleep(0.1) + 1 + 1 }) ``` @@ -78,4 +122,3 @@ Please report any [issues](https://github.com/poissonconsulting/hmstimer/issues) ## Code of Conduct Please note that the hmstimer project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. - diff --git a/README.md b/README.md index 8750e1c..f516cb5 100644 --- a/README.md +++ b/README.md @@ -18,42 +18,97 @@ status](https://www.r-pkg.org/badges/version/hmstimer)](https://cran.r-project.o `hmstimer` is an R package to track elapsed clock time using a -[hms::hms](https://github.com/tidyverse/hms) scalar, which if running -has an attribute named start that specifies the system time when the -timer was started. +[hms::hms](https://github.com/tidyverse/hms) scalar. -The elapsed time is the value of the scalar plus the difference between -the current system time and the system time when the timer was started. +`hmstimer` was originally developed to time Bayesian model runs. It +should not be used to estimate how long extremely fast code takes to +execute as the package code adds a small time cost. + +Create and start a timer with `tmr_timer(start = TRUE)`. ``` r library(hmstimer) -tmr <- tmr_timer(seconds = 125, start = TRUE) -tmr -#> 00:02:05 +tmr <- tmr_timer(start = TRUE) +Sys.sleep(0.1) +str(tmr) +#> 'hms' num 00:00:00 +#> - attr(*, "units")= chr "secs" +#> - attr(*, "title")= chr "" +#> - attr(*, "start")= num 1.72e+09 +hms::as_hms(tmr) +#> 00:00:00 +``` + +Get the elapsed time with `tmr_elapsed()`. The title is optional. + +``` r +tmr <- tmr_timer(start = TRUE, title = "my timer") + +Sys.sleep(0.1) tmr_elapsed(tmr) -#> 00:02:05.002463 -tmr -#> 00:02:05 +#> 00:00:00.103417 + +Sys.sleep(0.1) tmr_elapsed(tmr) -#> 00:02:05.00374 +#> 00:00:00.212112 +``` + +Stop the timer with `tmr_stop()`. +``` r tmr <- tmr_stop(tmr) +tmr_elapsed(tmr) +#> 00:00:00.216109 + +Sys.sleep(1) +tmr_elapsed(tmr) +#> 00:00:00.216109 +``` -tmr -#> 00:02:05.004366 +Restart the timer with `tmr_start()`. + +``` r +tmr <- tmr_start(tmr) tmr_elapsed(tmr) -#> 00:02:05.004366 +#> 00:00:00.21697 +Sys.sleep(0.1) +tmr_elapsed(tmr) +#> 00:00:00.324928 +``` + +There are several options for printing and formatting including coercing +to a hms object. + +``` r +tmr <- tmr_stop(tmr) +print(tmr) +#> 00:00:00.333247 +tmr_print(tmr) +#> [1] "00:00:00.333247 [my timer]" +tmr_format(tmr, digits = 5) +#> [1] "00:00:00.33325 [my timer]" +``` -tmr_format(tmr, digits = 4) -#> [1] "00:02:05.0044" +If running `tmr_print()` behaves differently. +``` r +tmr <- tmr_start(tmr) +tmr_print(tmr) +#> [1] "14:44:58 (+00:00:01 => 14:44:59) [my timer]" +``` + +The time for a block of code to complete can be printed using +`with_timer()`. + +``` r with_timer({ - Sys.sleep(1) - 1 + Sys.sleep(0.1) + Sys.sleep(0.1) + 1 + 1 }) -#> 00:00:01.005 -#> [1] 1 +#> 00:00:00.207 +#> [1] 2 ``` ## Installation diff --git a/_pkgdown.yml b/_pkgdown.yml index e244027..b8a9d61 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -25,6 +25,12 @@ reference: - tmr_elapsed - tmr_print - tmr_format +- title: Title + desc: Functions to confirm, get and set title + contents: + - tmr_is_titled + - tmr_title + - tmr_title<- - title: Miscellaneous Functions desc: Miscellaneous functions contents: diff --git a/man/hmstimer-package.Rd b/man/hmstimer-package.Rd index 2a9b7a2..5c5e4e8 100644 --- a/man/hmstimer-package.Rd +++ b/man/hmstimer-package.Rd @@ -8,7 +8,7 @@ \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} -Tracks elapsed clock time using a `hms::hms()` scalar, which if running has an attribute named start that specifies the system time when the timer was started. The elapsed time is the value of the scalar plus the difference between the current system time and the system time when the timer was started. +Tracks elapsed clock time using a `hms::hms()` scalar. It was was originally developed to time Bayesian model runs. It should not be used to estimate how long extremely fast code takes to execute as the package code adds a small time cost. } \seealso{ Useful links: diff --git a/man/local_timer.Rd b/man/local_timer.Rd index 9af3e22..b59ebb8 100644 --- a/man/local_timer.Rd +++ b/man/local_timer.Rd @@ -4,9 +4,15 @@ \alias{local_timer} \title{Local Timer} \usage{ -local_timer(.local_envir = rlang::caller_env()) +local_timer(..., title = "", srcref = TRUE, .local_envir = rlang::caller_env()) } \arguments{ +\item{...}{These dots are for future extensions and must be empty.} + +\item{title}{A string of the title.} + +\item{srcref}{A flag specifying whether to print the source reference.} + \item{.local_envir}{The environment to use for scoping.} } \description{ diff --git a/man/params.Rd b/man/params.Rd index 29b2b33..307f896 100644 --- a/man/params.Rd +++ b/man/params.Rd @@ -2,21 +2,43 @@ % Please edit documentation in R/params.R \name{params} \alias{params} -\title{Parameter Descriptions for hmstimer Functions} +\alias{parameters} +\alias{arguments} +\alias{args} +\title{Parameter Descriptions} \arguments{ -\item{.local_envir}{The environment to use for scoping.} +\item{...}{These dots are for future extensions and must be empty.} + +\item{code}{A line or block of R code.} -\item{code}{Code to time.} +\item{digits}{A count of the number of decimal places.} -\item{digits}{A whole number of the number of decimal places.} +\item{print_title}{A flag specifying whether to print the title.} \item{seconds}{A non-negative numeric scalar of the initial number of seconds.} -\item{start}{A flag indicating whether to start the timer.} +\item{srcref}{A flag specifying whether to print the source reference.} + +\item{start}{A flag specifying whether to start the timer.} + +\item{title}{A string of the title.} + +\item{value}{A string of the title.} \item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} + +\item{.local_envir}{The environment to use for scoping.} } \description{ -Parameter Descriptions for hmstimer Functions +Default parameter descriptions which may be overridden in individual +functions. +} +\details{ +A flag is a non-missing logical scalar. + +A string is a non-missing character scalar. + +A count is a non-missing non-negative integer scalar or double +scalar with no fractional part. } \keyword{internal} diff --git a/man/tmr_format.Rd b/man/tmr_format.Rd index eb37e32..4436271 100644 --- a/man/tmr_format.Rd +++ b/man/tmr_format.Rd @@ -4,12 +4,16 @@ \alias{tmr_format} \title{Format hms Timer} \usage{ -tmr_format(x, digits = 3) +tmr_format(x, digits = 3, ..., print_title = TRUE) } \arguments{ \item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} -\item{digits}{A whole number of the number of decimal places.} +\item{digits}{A count of the number of decimal places.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{print_title}{A flag specifying whether to print the title.} } \value{ A character string. diff --git a/man/tmr_is_titled.Rd b/man/tmr_is_titled.Rd new file mode 100644 index 0000000..6188c1e --- /dev/null +++ b/man/tmr_is_titled.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/is-titled.R +\name{tmr_is_titled} +\alias{tmr_is_titled} +\title{Is hms Timer Title} +\usage{ +tmr_is_titled(x) +} +\arguments{ +\item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} +} +\value{ +A flag (TRUE or FALSE). +} +\description{ +Tests if a \code{\link[=hms_timer]{hms_timer()}} has a title (as indicated by the +presence of an attribute named start). +} +\examples{ +tmr_is_titled(tmr_timer()) +tmr_is_titled(tmr_timer(title = "my timer")) +} diff --git a/man/tmr_print.Rd b/man/tmr_print.Rd index 2814f97..eba88e7 100644 --- a/man/tmr_print.Rd +++ b/man/tmr_print.Rd @@ -4,10 +4,14 @@ \alias{tmr_print} \title{Print hms Timer} \usage{ -tmr_print(x) +tmr_print(x, ..., print_title = TRUE) } \arguments{ \item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{print_title}{A flag specifying whether to print the title.} } \value{ A character string. diff --git a/man/tmr_round.Rd b/man/tmr_round.Rd index dc1f48c..87f3597 100644 --- a/man/tmr_round.Rd +++ b/man/tmr_round.Rd @@ -9,7 +9,7 @@ tmr_round(x, digits = 0) \arguments{ \item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} -\item{digits}{A whole number of the number of decimal places.} +\item{digits}{A count of the number of decimal places.} } \value{ A \code{\link[=hms_timer]{hms_timer()}}. diff --git a/man/tmr_start.Rd b/man/tmr_start.Rd index ba92d76..791c9e5 100644 --- a/man/tmr_start.Rd +++ b/man/tmr_start.Rd @@ -4,10 +4,14 @@ \alias{tmr_start} \title{Start hms Timer} \usage{ -tmr_start(x) +tmr_start(x, ..., title = NULL) } \arguments{ \item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{title}{A string of the title.} } \value{ A started \code{\link[=hms_timer]{hms_timer()}}. diff --git a/man/tmr_timer.Rd b/man/tmr_timer.Rd index d02837d..f6f5760 100644 --- a/man/tmr_timer.Rd +++ b/man/tmr_timer.Rd @@ -4,12 +4,16 @@ \alias{tmr_timer} \title{Create hms Timer} \usage{ -tmr_timer(seconds = 0, start = FALSE) +tmr_timer(seconds = 0, start = FALSE, ..., title = "") } \arguments{ \item{seconds}{A non-negative numeric scalar of the initial number of seconds.} -\item{start}{A flag indicating whether to start the timer.} +\item{start}{A flag specifying whether to start the timer.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{title}{A string of the title.} } \value{ A \code{\link[=hms_timer]{hms_timer()}}. @@ -18,9 +22,10 @@ A \code{\link[=hms_timer]{hms_timer()}}. Creates a \code{\link[=hms_timer]{hms_timer()}}. } \examples{ -tmr <- tmr_timer() -print(tmr) -class(tmr) +tmr_timer() +tmr_timer(1, start = TRUE, title = "my timer") +class(tmr_timer(2)) +str(tmr_timer(2, start = TRUE, title = "a timer")) } \seealso{ Other start_stop: diff --git a/man/tmr_title-set.Rd b/man/tmr_title-set.Rd new file mode 100644 index 0000000..e53faa1 --- /dev/null +++ b/man/tmr_title-set.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/title.R +\name{tmr_title<-} +\alias{tmr_title<-} +\title{Set Title hms Timer} +\usage{ +tmr_title(x) <- value +} +\arguments{ +\item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} + +\item{value}{A string of the title.} +} +\value{ +A copy of the \code{\link[=hms_timer]{hms_timer()}} with the new title. +} +\description{ +Sets the title of a \code{\link[=hms_timer]{hms_timer()}}. +} +\examples{ +tmr <- tmr_timer(title = "A title") +tmr_print(tmr) +tmr_title(tmr) <- "A different title" +tmr_print(tmr) +tmr_title(tmr) <- NULL +tmr_print(tmr) +} +\seealso{ +\code{\link[=tmr_title]{tmr_title()}} +} diff --git a/man/tmr_title.Rd b/man/tmr_title.Rd new file mode 100644 index 0000000..87a217c --- /dev/null +++ b/man/tmr_title.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/title.R +\name{tmr_title} +\alias{tmr_title} +\title{Get Title hms Timer} +\usage{ +tmr_title(x) +} +\arguments{ +\item{x}{A \code{\link[=hms_timer]{hms_timer()}}.} +} +\value{ +A flag of the title. +} +\description{ +Returns a flag (character vector) of the title. +} +\examples{ +tmr_title(tmr_timer()) +tmr_title(tmr_timer(title = "")) +tmr_title(tmr_timer(title = "A Title")) +} +\seealso{ +\code{\link[=tmr_title<-]{tmr_title<-()}} +} diff --git a/man/with_timer.Rd b/man/with_timer.Rd index d715ba7..10697e9 100644 --- a/man/with_timer.Rd +++ b/man/with_timer.Rd @@ -4,10 +4,16 @@ \alias{with_timer} \title{With Timer} \usage{ -with_timer(code) +with_timer(code, ..., title = FALSE, srcref = FALSE) } \arguments{ -\item{code}{Code to time.} +\item{code}{A line or block of R code.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{title}{A flag specifying whether to add a title based on code.} + +\item{srcref}{A flag specifying whether to print the source reference.} } \value{ The result of executing the code. diff --git a/scripts/file.R b/scripts/file.R new file mode 100644 index 0000000..45124bc --- /dev/null +++ b/scripts/file.R @@ -0,0 +1,7 @@ +test_local_timer <- function() { + local_timer(title = "a title") + Sys.sleep(0.1) + 20 +} + +test_local_timer() diff --git a/tests/testthat/test-ceiling.R b/tests/testthat/test-ceiling.R index 4861cb0..228ac40 100644 --- a/tests/testthat/test-ceiling.R +++ b/tests/testthat/test-ceiling.R @@ -16,3 +16,8 @@ test_that("tmr_ceiling elapsed", { Sys.sleep(0.001) expect_identical(tmr_ceiling(tmr_stop(tmr)), tmr_timer(1)) }) + +test_that("tmr_ceiling title preserved", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_identical(tmr_title(tmr_ceiling(tmr)), "a title") +}) diff --git a/tests/testthat/test-elapsed.R b/tests/testthat/test-elapsed.R new file mode 100644 index 0000000..a096a2e --- /dev/null +++ b/tests/testthat/test-elapsed.R @@ -0,0 +1,15 @@ +test_that("tmr_elapsed", { + tmr <- tmr_timer() + expect_identical(tmr_elapsed(tmr), tmr) + tmr <- tmr_start(tmr) + sys_time <- as.numeric(Sys.time()) + expect_gte(attr(tmr_elapsed(tmr), "start"), sys_time) + expect_true(tmr_is_started(tmr)) + elapsed <- tmr_elapsed(tmr) + expect_lte(tmr_elapsed(elapsed), tmr_elapsed(tmr)) + expect_lte(tmr_elapsed(tmr), tmr_elapsed(elapsed)) + Sys.sleep(1) + tmr <- tmr_stop(tmr) + expect_gte(as.numeric(tmr), 1) + expect_identical(tmr_elapsed(tmr), tmr) +}) diff --git a/tests/testthat/test-floor.R b/tests/testthat/test-floor.R index 678a272..698e1d9 100644 --- a/tests/testthat/test-floor.R +++ b/tests/testthat/test-floor.R @@ -16,3 +16,8 @@ test_that("tmr_floor elapsed", { Sys.sleep(0.001) expect_identical(tmr_floor(tmr_stop(tmr)), tmr_timer()) }) + +test_that("tmr_floor title preserved", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_identical(tmr_title(tmr_floor(tmr)), "a title") +}) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index d737b38..4d2823b 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -14,10 +14,20 @@ test_that("format", { expect_identical(tmr_format(tmr_timer(123.40001), digits = 0), "00:02:03") }) -test_that("tmr_round digit errors", { +test_that("tmr_format digit errors", { tmr <- tmr_timer() expect_error(tmr_format(tmr, digits = 1:2), "^`digits` must be a scalar[.]$") expect_error(tmr_format(tmr, digits = NA), "^`digits` must be numeric[.]$") expect_error(tmr_format(tmr, digits = NA_real_), "`digits` must not be a missing value[.]$") expect_error(tmr_format(tmr, digits = 0.5), "`digits` must be a whole number[.]$") }) + +test_that("format title", { + expect_identical(tmr_format(tmr_timer(title = "")), "00:00:00.000") + expect_identical(tmr_format(tmr_timer(title = NULL)), "00:00:00.000") + expect_identical(tmr_format(tmr_timer(title = "a title")), "00:00:00.000 [a title]") +}) + +test_that("format title print_title = FALSE", { + expect_identical(tmr_format(tmr_timer(title = "a title"), print_title = FALSE), "00:00:00.000") +}) diff --git a/tests/testthat/test-is-started.R b/tests/testthat/test-is-started.R new file mode 100644 index 0000000..f9b66e1 --- /dev/null +++ b/tests/testthat/test-is-started.R @@ -0,0 +1,31 @@ +test_that("tmr_is_started", { + expect_false(tmr_is_started(tmr_timer())) + expect_true(tmr_is_started(tmr_timer(start = TRUE))) + expect_false(tmr_is_started(hms::as_hms(1))) + + expect_error(tmr_is_started(1), "^`x` must be class hms[.]$") + expect_error( + tmr_is_started(hms::as_hms(c(1, 2))), + "^`x` must be a scalar[.]$" + ) + expect_error( + tmr_is_started(hms::as_hms(NA)), + "^`x` must not be a missing value[.]$" + ) +}) + +test_that("tmr_is_started", { + expect_false(tmr_is_started(tmr_timer())) + expect_true(tmr_is_started(tmr_timer(start = TRUE))) + expect_false(tmr_is_started(hms::as_hms(1))) + + expect_error(tmr_is_started(1), "^`x` must be class hms[.]$") + expect_error( + tmr_is_started(hms::as_hms(c(1, 2))), + "^`x` must be a scalar[.]$" + ) + expect_error( + tmr_is_started(hms::as_hms(NA)), + "^`x` must not be a missing value[.]$" + ) +}) diff --git a/tests/testthat/test-is-stopped.R b/tests/testthat/test-is-stopped.R new file mode 100644 index 0000000..4caeea2 --- /dev/null +++ b/tests/testthat/test-is-stopped.R @@ -0,0 +1,15 @@ +test_that("tmr_is_stopped", { + expect_true(tmr_is_stopped(tmr_timer())) + expect_false(tmr_is_stopped(tmr_timer(start = TRUE))) + expect_true(tmr_is_stopped(hms::as_hms(1))) + + expect_error(tmr_is_stopped(1), "^`x` must be class hms[.]$") + expect_error( + tmr_is_stopped(hms::as_hms(c(1, 2))), + "^`x` must be a scalar[.]$" + ) + expect_error( + tmr_is_stopped(hms::as_hms(NA)), + "^`x` must not be a missing value[.]$" + ) +}) diff --git a/tests/testthat/test-is-titled.R b/tests/testthat/test-is-titled.R new file mode 100644 index 0000000..49ab0f0 --- /dev/null +++ b/tests/testthat/test-is-titled.R @@ -0,0 +1,4 @@ +test_that("tmr_is_titled works", { + expect_false(tmr_is_titled(tmr_timer())) + expect_true(tmr_is_titled(tmr_timer(title = "my timer"))) +}) diff --git a/tests/testthat/test-local-timer.R b/tests/testthat/test-local-timer.R index ba4c85e..521cb56 100644 --- a/tests/testthat/test-local-timer.R +++ b/tests/testthat/test-local-timer.R @@ -4,7 +4,7 @@ test_that("local_timer", { Sys.sleep(0.1) 10 } - expect_message(expect_identical(fun(), 10), "^00:00:00\\.\\d{3,3}\\s$") + expect_message(expect_identical(fun(), 10), "^00:00:00\\.\\d{3,3} \\[test-local-timer\\.R:3\\]\\s$") }) test_that("test_local_timer()", { @@ -14,5 +14,66 @@ test_that("test_local_timer()", { 20 } + expect_message(expect_identical(test_local_timer(), 20), "^00:00:00\\.\\d{3,3} \\[test-local-timer\\.R:12\\]\\s$") +}) + +test_that("local_timer title", { + fun <- function(x) { + tmr <- local_timer(title = "a title") + Sys.sleep(0.1) + 10 + } + expect_message(expect_identical(fun(), 10), "^00:00:00\\.\\d{3,3} \\[test-local-timer\\.R:22 - a title\\]\\s$") +}) + +test_that("test_local_timer() title", { + test_local_timer <- function() { + local_timer(title = "a title", srcref = FALSE) + Sys.sleep(0.1) + 20 + } + + expect_message(expect_identical(test_local_timer(), 20), "^00:00:00\\.\\d{3,3} \\[a title\\]\\s$") +}) + +test_that("local_timer", { + fun <- function(x) { + tmr <- local_timer(srcref = FALSE) + Sys.sleep(0.1) + 10 + } + expect_message(expect_identical(fun(), 10), "^00:00:00\\.\\d{3,3}\\s$") +}) + +test_that("test_local_timer()", { + test_local_timer <- function() { + local_timer(srcref = FALSE) + Sys.sleep(0.1) + 20 + } + expect_message(expect_identical(test_local_timer(), 20), "^00:00:00\\.\\d{3,3}\\s$") }) + +test_that("local_timer title", { + fun <- function(x) { + tmr <- local_timer(title = "a title", srcref = FALSE) + Sys.sleep(0.1) + 10 + } + expect_message(expect_identical(fun(), 10), "^00:00:00\\.\\d{3,3} \\[a title\\]\\s$") +}) + +test_that("test_local_timer() title", { + test_local_timer <- function() { + local_timer(title = "a title", srcref = FALSE) + Sys.sleep(0.1) + 20 + } + + expect_message(expect_identical(test_local_timer(), 20), "^00:00:00\\.\\d{3,3} \\[a title\\]\\s$") +}) + +test_that("local_timer .local_envir fails", { + expect_error(local_timer(.local_envir = 1), "^`env` must be an environment\\.$") +}) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 30c5d7e..0db1eb3 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -6,9 +6,44 @@ test_that("test tmr_print output", { test_that("test class", { tmr <- tmr_start(tmr_timer()) - x <- tmr_print(tmr) + expect_output(x <- tmr_print(tmr), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\)\"$") expect_s3_class(x, "hms") expect_s3_class(x, "difftime") - expect_invisible(tmr_print(tmr)) + expect_output(expect_invisible(tmr_print(tmr)), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\)\"$") expect_identical(tmr, x) }) + +test_that("test print started NULL title", { + tmr <- tmr_timer(start = TRUE, title = NULL) + expect_output(tmr_print(tmr), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\)\"$") +}) + +test_that("test print started title no length", { + tmr <- tmr_timer(start = TRUE, title = "") + expect_output(tmr_print(tmr), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\)\"$") +}) + +test_that("test print started with title", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_output(tmr_print(tmr), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\) \\[a title\\]\"$") +}) + +test_that("test print print_title = FALSE", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_output(tmr_print(tmr, print_title = FALSE), "^\\[1\\] \"(\\d{2}:){2}\\d{2} \\(\\+(0{2}:){2}\\d{2} => (\\d{2}:){2}\\d{2}\\)\"$") +}) + +test_that("test print not started no title", { + tmr <- tmr_timer() + expect_output(tmr_print(tmr), "^\\[1\\] \"00:00:00\"$") +}) + +test_that("test print not started title no length", { + tmr <- tmr_timer(title = "") + expect_output(tmr_print(tmr), "^\\[1\\] \"00:00:00\"$") +}) + +test_that("test print not started with title", { + tmr <- tmr_timer(title = "thing") + expect_output(tmr_print(tmr), "^\\[1\\] \"00:00:00 \\[thing\\]\"$") +}) diff --git a/tests/testthat/test-reset.R b/tests/testthat/test-reset.R index 4364e29..e4fabcf 100644 --- a/tests/testthat/test-reset.R +++ b/tests/testthat/test-reset.R @@ -4,3 +4,8 @@ test_that("tmr_reset", { expect_true(tmr_is_started(tmr_reset(tmr_timer(start = TRUE)))) expect_identical(tmr_reset(tmr_timer(1), 2), tmr_timer(2)) }) + +test_that("tmr_reset title preserved", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_identical(tmr_title(tmr_reset(tmr)), "a title") +}) diff --git a/tests/testthat/test-round.R b/tests/testthat/test-round.R index 6aae9ac..62342ba 100644 --- a/tests/testthat/test-round.R +++ b/tests/testthat/test-round.R @@ -22,3 +22,8 @@ test_that("tmr_round digits", { expect_identical(tmr_round(tmr_timer(1.09), digits = 1), tmr_timer(1.1)) expect_identical(tmr_round(tmr_timer(1.09), digits = 2), tmr_timer(1.09)) }) + +test_that("tmr_round title preserved", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_identical(tmr_title(tmr_round(tmr)), "a title") +}) diff --git a/tests/testthat/test-start.R b/tests/testthat/test-start.R new file mode 100644 index 0000000..e7b29e4 --- /dev/null +++ b/tests/testthat/test-start.R @@ -0,0 +1,16 @@ +test_that("tmr_start", { + tmr <- tmr_timer() + expect_false(tmr_is_started(tmr)) + tmr <- tmr_start(tmr) + expect_true(tmr_is_started(tmr)) + expect_warning(tmr_start(tmr), "^`x` is already started[.]$") + + expect_error(tmr_start(1), "^`x` must be class hms[.]$") + expect_error(tmr_start(hms::as_hms(NA)), "^`x` must not be a missing value[.]$") + expect_error(tmr_start(hms::as_hms(c(1, 2))), "^`x` must be a scalar[.]$") +}) + +test_that("tmr_start title preserved", { + tmr <- tmr_timer(start = FALSE, title = "a title") + expect_identical(tmr_title(tmr_start(tmr)), "a title") +}) diff --git a/tests/testthat/test-stop.R b/tests/testthat/test-stop.R new file mode 100644 index 0000000..1921754 --- /dev/null +++ b/tests/testthat/test-stop.R @@ -0,0 +1,16 @@ +test_that("tmr_stop", { + tmr <- tmr_timer(start = TRUE) + expect_false(tmr_is_stopped(tmr)) + tmr <- tmr_stop(tmr) + expect_true(tmr_is_stopped(tmr)) + expect_warning(tmr_stop(tmr), "^`x` is already stopped[.]$") + + expect_error(tmr_stop(1), "^`x` must be class hms[.]$") + expect_error(tmr_stop(hms::as_hms(NA)), "^`x` must not be a missing value[.]$") + expect_error(tmr_stop(hms::as_hms(c(1, 2))), "^`x` must be a scalar[.]$") +}) + +test_that("tmr_stop title preserved", { + tmr <- tmr_timer(start = TRUE, title = "a title") + expect_identical(tmr_title(tmr_stop(tmr)), "a title") +}) diff --git a/tests/testthat/test-timer.R b/tests/testthat/test-timer.R index bfa7069..4e8de32 100644 --- a/tests/testthat/test-timer.R +++ b/tests/testthat/test-timer.R @@ -21,90 +21,12 @@ test_that("tmr_timer", { expect_type(attr(x, "start"), "double") }) -test_that("tmr_is_started", { - expect_false(tmr_is_started(tmr_timer())) - expect_true(tmr_is_started(tmr_timer(start = TRUE))) - expect_false(tmr_is_started(hms::as_hms(1))) - - expect_error(tmr_is_started(1), "^`x` must be class hms[.]$") - expect_error( - tmr_is_started(hms::as_hms(c(1, 2))), - "^`x` must be a scalar[.]$" - ) - expect_error( - tmr_is_started(hms::as_hms(NA)), - "^`x` must not be a missing value[.]$" - ) -}) - -test_that("tmr_is_started", { - expect_false(tmr_is_started(tmr_timer())) - expect_true(tmr_is_started(tmr_timer(start = TRUE))) - expect_false(tmr_is_started(hms::as_hms(1))) - - expect_error(tmr_is_started(1), "^`x` must be class hms[.]$") - expect_error( - tmr_is_started(hms::as_hms(c(1, 2))), - "^`x` must be a scalar[.]$" - ) - expect_error( - tmr_is_started(hms::as_hms(NA)), - "^`x` must not be a missing value[.]$" - ) -}) - -test_that("tmr_is_stopped", { - expect_true(tmr_is_stopped(tmr_timer())) - expect_false(tmr_is_stopped(tmr_timer(start = TRUE))) - expect_true(tmr_is_stopped(hms::as_hms(1))) - - expect_error(tmr_is_stopped(1), "^`x` must be class hms[.]$") - expect_error( - tmr_is_stopped(hms::as_hms(c(1, 2))), - "^`x` must be a scalar[.]$" - ) - expect_error( - tmr_is_stopped(hms::as_hms(NA)), - "^`x` must not be a missing value[.]$" - ) -}) - -test_that("tmr_start", { - tmr <- tmr_timer() - expect_false(tmr_is_started(tmr)) - tmr <- tmr_start(tmr) - expect_true(tmr_is_started(tmr)) - expect_warning(tmr_start(tmr), "^`x` is already started[.]$") - - expect_error(tmr_start(1), "^`x` must be class hms[.]$") - expect_error(tmr_start(hms::as_hms(NA)), "^`x` must not be a missing value[.]$") - expect_error(tmr_start(hms::as_hms(c(1, 2))), "^`x` must be a scalar[.]$") -}) - -test_that("tmr_stop", { - tmr <- tmr_timer(start = TRUE) - expect_false(tmr_is_stopped(tmr)) - tmr <- tmr_stop(tmr) - expect_true(tmr_is_stopped(tmr)) - expect_warning(tmr_stop(tmr), "^`x` is already stopped[.]$") - - expect_error(tmr_stop(1), "^`x` must be class hms[.]$") - expect_error(tmr_stop(hms::as_hms(NA)), "^`x` must not be a missing value[.]$") - expect_error(tmr_stop(hms::as_hms(c(1, 2))), "^`x` must be a scalar[.]$") +test_that("tmr_timer title errors", { + expect_error(tmr_timer(title = 1), "`title` must be numeric\\.$") + expect_error(tmr_timer(title = c("1", "2")), "`title` must be a scalar\\.$") + expect_error(tmr_timer(title = NA_character_), "`title` must not be a missing value\\.$") }) -test_that("tmr_elapsed", { - tmr <- tmr_timer() - expect_identical(tmr_elapsed(tmr), tmr) - tmr <- tmr_start(tmr) - sys_time <- as.numeric(Sys.time()) - expect_gte(attr(tmr_elapsed(tmr), "start"), sys_time) - expect_true(tmr_is_started(tmr)) - elapsed <- tmr_elapsed(tmr) - expect_lte(tmr_elapsed(elapsed), tmr_elapsed(tmr)) - expect_lte(tmr_elapsed(tmr), tmr_elapsed(elapsed)) - Sys.sleep(1) - tmr <- tmr_stop(tmr) - expect_gte(as.numeric(tmr), 1) - expect_identical(tmr_elapsed(tmr), tmr) +test_that("tmr_timer dots empty", { + expect_error(tmr_timer(title2 = 1)) }) diff --git a/tests/testthat/test-title.R b/tests/testthat/test-title.R new file mode 100644 index 0000000..12fc2d3 --- /dev/null +++ b/tests/testthat/test-title.R @@ -0,0 +1,20 @@ +test_that("tmr_title works", { + expect_identical(tmr_title(tmr_timer()), "") + expect_identical(tmr_title(tmr_timer(title = NULL)), "") + expect_identical(tmr_title(tmr_timer(title = "")), "") + expect_identical(tmr_title(tmr_timer(title = "a tiTLE..")), "a tiTLE..") + expect_identical(tmr_title(tmr_timer(title = c(tt = "a tiTLE.."))), "a tiTLE..") +}) + +test_that("tmr_title<- works", { + tmr <- tmr_timer(title = "A title") + expect_identical(tmr_title(tmr), "A title") + tmr_title(tmr) <- "A different title" + expect_identical(tmr_title(tmr), "A different title") + tmr_title(tmr) <- NULL + expect_identical(tmr_title(tmr), "") + tmr_title(tmr) <- "" + expect_identical(tmr_title(tmr), "") + tmr_title(tmr) <- c(tt = "a tiTLE..") + expect_identical(tmr_title(tmr), "a tiTLE..") +}) diff --git a/tests/testthat/test-with-timer.R b/tests/testthat/test-with-timer.R index a64eca1..850a45c 100644 --- a/tests/testthat/test-with-timer.R +++ b/tests/testthat/test-with-timer.R @@ -14,3 +14,44 @@ test_that("with_timer", { 20 }), 20), "^00:00:00\\.\\d{3,3}\\s$") }) + +test_that("with_timer", { + fun <- function() { + Sys.sleep(0.1) + 10 + } + expect_message(expect_identical(with_timer(fun(), title = TRUE), 10), "^00:00:00\\.\\d{3,3} \\[`fun\\(\\)`\\]\\s$") +}) + +test_that("with_timer title = TRUE", { + expect_message(expect_identical(with_timer( + { + for (i in 1:2) { + Sys.sleep(0.1) + } + 20 + }, + title = TRUE + ), 20), "^00:00:00\\.\\d{3,3} \\[`\\{ \\.{3,3} \\}`\\]\\s$") +}) + +test_that("with_timer srcref = TRUE", { + fun <- function() { + Sys.sleep(0.1) + 10 + } + # Can't do .+ to match file:line because in some settings no file/line info is present + expect_message(expect_identical(with_timer(fun(), srcref = TRUE), 10), "^00:00:00\\.\\d{3,3} \\[.*:.*\\]\\s$") +}) + +test_that("with_timer", { + expect_message(expect_identical(with_timer( + { + for (i in 1:2) { + Sys.sleep(0.1) + } + 20 + }, + srcref = TRUE + ), 20), "^00:00:00\\.\\d{3,3} \\[.*:.*\\]\\s$") +})