Restore desired soft deprecation behaviour

DESCRIPTION

@@ -28,7 +28,8 @@ Suggests:
     tibble,
     tidyverse,
     tools,
-    vctrs
+    vctrs,
+    withr
 VignetteBuilder: 
     knitr
 Config/testthat/edition: 3

NEWS.md

@@ -1,5 +1,15 @@
 # lifecycle (development version)
 
+* In tests, `deprecate_soft()` will only warn if the deprecated function
+  is called directly from the package being tested, not one of its dependencies.
+  This ensures that you only see the warning when it's your responsibility to 
+  do something about it (#134).
+
+* `deprecate_soft()` will never warn when called on CRAN, ensuring that soft 
+  deprecation will never break a reverse dependency (#134).
+
+* Soft deprecations now only warn every 8 hours in non-package code (#134).
+
 # lifecycle 1.0.2
 
 * You can now generate arbitrary text in a deprecation message by

R/deprecated.R

@@ -4,9 +4,11 @@
 #' These functions provide three levels of verbosity for deprecated
 #' functions. Learn how to use them in `vignette("communicate")`.
 #'
-#' * `deprecate_soft()` warns only if the deprecated function is
-#'   called from the global environment or from the package currently
-#'   being tested.
+#' * `deprecate_soft()` warns only if the deprecated function is called
+#'   directly, i.e. a user is calling a function they wrote in the global
+#'   environment or a developer is calling it in their package. It does not
+#'   warn when called indirectly, i.e. the deprecation comes from code that
+#'   you don't control.
 #'
 #' * `deprecate_warn()` warns unconditionally.
 #'
@@ -102,14 +104,13 @@ deprecate_soft <- function(when,
   verbosity <- lifecycle_verbosity()
   if (verbosity == "quiet") {
     NULL
-  } else if (verbosity %in% "warning" ||
-             (is_string(verbosity, "default") && env_inherits_global(user_env))) {
-    trace <- trace_back(bottom = caller_env())
-    deprecate_warn0(msg, trace, always = TRUE)
+  } else if (verbosity %in% c("warning", "default")) {
+    if (is_direct(user_env)) {
+      always <- verbosity == "warning"
+      deprecate_warn0(msg, id, trace_back(bottom = caller_env()), always = always)
+    }
   } else if (verbosity == "error") {
     deprecate_stop0(msg)
-  } else {
-    deprecate_soft0(msg)
   }
 
   invisible(NULL)
@@ -134,21 +135,11 @@ deprecate_warn <- function(when,
   verbosity <- lifecycle_verbosity()
   if (verbosity == "quiet") {
     NULL
-  } else if (verbosity == "warning") {
-    trace <- trace_back(bottom = caller_env())
-    deprecate_warn0(msg, trace, always = TRUE)
+  } else if (verbosity %in% c("default", "warning")) {
+    always <- always || verbosity == "warning"
+    deprecate_warn0(msg, id, trace_back(bottom = caller_env()), always = always)
   } else if (verbosity == "error") {
     deprecate_stop0(msg)
-  } else {
-    id <- id %||% msg
-
-    if (always || needs_warning(id)) {
-      # Prevent warning from being displayed again
-      env_poke(deprecation_env, id, Sys.time())
-
-      trace <- trace_back(bottom = caller_env())
-      deprecate_warn0(msg, trace, always = always)
-    }
   }
 
   invisible(NULL)
@@ -169,11 +160,15 @@ deprecate_stop <- function(when,
 
 # Signals -----------------------------------------------------------------
 
-deprecate_soft0 <- function(msg) {
-  signal(msg, "lifecycle_soft_deprecated")
-}
+deprecate_warn0 <- function(msg, id = NULL, trace = NULL, always = FALSE) {
+  id <- id %||% msg
+  if (!always && !needs_warning(id)) {
+    return()
+  }
+
+  # Prevent warning from being displayed again
+  env_poke(deprecation_env, id, Sys.time())
 
-deprecate_warn0 <- function(msg, trace = NULL, always = FALSE) {
   footer <- function(...) {
     if (is_interactive()) {
       c(
@@ -294,6 +289,10 @@ lifecycle_message_with <- function(with, what) {
 
 # Helpers -----------------------------------------------------------------
 
+is_direct <- function(env) {
+  env_inherits_global(env) || from_testthat(env)
+}
+
 env_inherits_global <- function(env) {
   # `topenv(emptyenv())` returns the global env. Return `FALSE` in
   # that case to allow passing the empty env when the
@@ -306,6 +305,18 @@ env_inherits_global <- function(env) {
   is_reference(topenv(env), global_env())
 }
 
+# TRUE if we are in unit tests and the package being tested is the
+# same as the package that called
+from_testthat <- function(env) {
+  tested_package <- Sys.getenv("TESTTHAT_PKG")
+
+  # Test for environment names rather than reference/contents because
+  # testthat clones the namespace
+  nzchar(tested_package) &&
+    identical(Sys.getenv("NOT_CRAN"), "true") &&
+    env_name(topenv(env)) == paste0("namespace:", tested_package)
+}
+
 needs_warning <- function(id) {
   if (!is_string(id)) {
     lifecycle_abort("`id` must be a string")

R/verbosity.R

@@ -13,10 +13,10 @@
 #' You can control the level of verbosity with the global option
 #' `lifecycle_verbosity`. It can be set to:
 #'
-#' * `"default"` or `NULL` for the default non-disruptive settings.
-#'
-#' * `"quiet"`, `"warning"` or `"error"` to force silence, warnings or
-#'   errors for deprecated functions.
+#' * `"quiet"` to suppress all deprecation messages.
+#' * `"default"` or `NULL` to warn once every 8 hours.
+#' * `"warning"` to warn every time.
+#' * `"error"` to error instead of warning.
 #'
 #' Note that functions calling [deprecate_stop()] invariably throw
 #' errors.

tests/testthat/test-deprecated.R

@@ -4,7 +4,6 @@ test_that("default deprecations behave as expected", {
   on.exit(env_unbind(deprecation_env, "test"))
   local_options(lifecycle_verbosity = "default")
 
-  expect_condition(deprecate_soft("1.0.0", "foo()"), class = "lifecycle_soft_deprecated")
   expect_warning(deprecate_warn("1.0.0", "foo()", id = "test"), class = "lifecycle_warning_deprecated")
   expect_warning(deprecate_warn("1.0.0", "foo()", id = "test"), NA)
   expect_defunct(deprecate_stop("1.0.0", "foo()"))
@@ -40,7 +39,6 @@ test_that("quiet suppresses _soft and _warn", {
 test_that("warning always warns in _soft and _warn", {
   local_options(lifecycle_verbosity = "warning")
 
-  expect_deprecated(deprecate_soft("1.0.0", "foo()"))
   expect_deprecated(deprecate_warn("1.0.0", "foo()"))
   expect_defunct(deprecate_stop("1.0.0", "foo()"))
 })
@@ -54,7 +52,7 @@ test_that("error coverts _soft and _warn to errors", {
 })
 
 test_that("soft deprecation uses correct calling envs", {
-  local_options(lifecycle_verbosity = "default")
+  withr::local_envvar(TESTTHAT_PKG = "testpackage")
 
   # Simulate package functions available from global environment
   env <- new_environment(parent = ns_env("lifecycle"))
@@ -68,15 +66,14 @@ test_that("soft deprecation uses correct calling envs", {
   })
   local_bindings(!!!as.list(env), .env = global_env())
 
-  # Calling package function directly should warning
+  # Calling package function directly should warn
   cnd <- catch_cnd(evalq(softly(), global_env()), "warning")
   expect_s3_class(cnd, class = "lifecycle_warning_deprecated")
   expect_match(conditionMessage(cnd), "lifecycle")
 
   # Calling package function indirectly from global env shouldn't
-  cnd <- catch_cnd(evalq(softly_softly(), global_env()), "lifecycle_soft_deprecated")
-  expect_s3_class(cnd, class = "lifecycle_soft_deprecated")
-  expect_match(conditionMessage(cnd), "lifecycle")
+  cnd <- catch_cnd(evalq(softly_softly(), global_env()), "warning")
+  expect_equal(cnd, NULL)
 })
 
 test_that("warning conditions are signaled only once if warnings are suppressed", {

tests/testthat/test-lifecycle.R

@@ -1,5 +1,5 @@
 test_that("deprecate_soft() warns when called from global env", {
-  local_options(lifecycle_verbosity = NULL)
+  withr::local_envvar(TESTTHAT_PKG = "testpackage")
 
   fn <- function(id) {
     deprecate_soft("1.0.0", "foo()", id = id)
@@ -79,10 +79,15 @@ test_that("the topenv of the empty env is not the global env", {
 })
 
 test_that("expect_deprecated() matches regexp", {
-  expect_deprecated(deprecate_soft("1.0", "fn()", details = "foo"), "foo")
-  expect_deprecated(deprecate_warn("1.0", "fn()", details = "foo.["), "foo.[", fixed = TRUE)
+  expect_deprecated(
+    deprecate_warn("1.0", "fn()", details = "foo.["), "foo.[", fixed = TRUE
+  )
 
+  fn <- function() {
+    deprecate_soft("1.0.0", "fn()")
+  }
+  expect_deprecated(fn(), "fn")
   expect_deprecated(expect_failure(
-    expect_deprecated(deprecate_soft("1.0", "fn()"), "foo")
+    expect_deprecated(fn(), "foo")
   ))
 })