get(<missing arg>) now signals error of class "GetMissingError"

git-svn-id: https://svn.r-project.org/R/trunk@87080 00db46b3-68df-0310-9c12-caf00c1e9a41

doc/NEWS.Rd

@@ -79,6 +79,8 @@
  to \PR{16567}.
 
  \item \code{pnorm(x)} underflows more gracefully.
+
+ \item \code{get(nam, env)} now signals a \emph{classed} error (\code{"getMissingError"})
  }
  }
 
@@ -258,8 +260,8 @@
  on some platforms, warns about \emph{some} failures to change the
  language and gets an option related to these warning messages.
 
- \item Printing \code{ls.str()} now tries harder to show
- \code{"<missing>"} even when \R's language setting is not English.
+ \item Printing \code{ls.str()} now shows \code{"<missing>"} even when
+ \R's language setting is not English.
  }
  }
 }

src/library/base/man/get.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/get.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2023 R Core Team
+% Copyright 1995-2024 R Core Team
 % Distributed under GPL 2 or later
 
 \name{get}
@@ -82,6 +82,9 @@ dynGet(x, ifnotfound = , minframe = 1L, inherits = FALSE)
 }
 \value{
  For \code{get}, the object found. If no object is found an error results.
+ If the object is the internal missing argument (aka \code{R_MissingArg}
+ in C), a \emph{classed} error, class \code{"getMissingError"} is
+ signalled.
 
  For \code{mget}, a named list of objects (found or specified \emph{via}
  \code{ifnotfound}).
@@ -116,5 +119,16 @@ get("\%o\%")
 ## test mget
 e1 <- new.env()
 mget(letters, e1, ifnotfound = as.list(LETTERS))
+
+## very low-level: get()ing the "missing argument", e.g., inside browser()
+ls.str(E <- environment((\(m) \(){})())) # m : <missing>
+str(E$m) # (empty) symbol
+tryCatch(get("m",E), error = function(e) e) # <getMissingError ....>
+stopifnot(exprs = {
+ inherits(tryCatch(get ("m", E), error=identity), "getMissingError")
+ inherits(tryCatch(get0("m", E), error=identity), "getMissingError")
+ is.symbol(E$m) # => valid argument to get(), and *also* gets 'missing arg':
+ inherits(tryCatch(get ( E$m ) , error=identity), "getMissingError")
+})
 }
 \keyword{data}

src/library/utils/R/str.R

@@ -696,28 +696,14 @@ print.ls_str <- function(x, max.level = 1, give.attr = FALSE,
  strargs <- c(list(max.level = max.level, give.attr = give.attr,
  digits.d = digits), args)
  n. <- substr(tempfile("ls_str_", tmpdir=""), 2L, 20L)
- if(is.na(L <- Sys.getenv("LANGUAGE", unset=NA)) || L != "en") {
- Sys.setLanguage("en", C.vs.en="silent") # for "<missing>" to work below
- on.exit(if(is.na(L)) Sys.unsetenv("LANGUAGE") else Sys.setenv(LANGUAGE = L))
- }
  for(nam in x) {
  cat(nam, ": ")
  ## check missingness, e.g. inside debug(.) :
-
-##__ Why does this give too many <missing> in some case?
-##__ if(eval(substitute(missing(.), list(. = as.name(nam))),
-##__ envir = E))
-##__ cat("<missing>\n")
-##__ else
-##__ str(get(nam, envir = E, mode = M),
-##__ max.level = max.level, give.attr = give.attr, ...)
-
- ## FIXME: get() should rather return a *classed* error in this case
- eA <- sprintf("%s:%s", nam, n.)
+ eA <- sprintf("%s:%s", nam, n.) # need a 'mark' in case nam *is* an error object
  o <- tryCatch(get(nam, envir = E, mode = M),
  error = function(e){ attr(e, eA) <- TRUE; e })
  if(inherits(o, "error") && isTRUE(attr(o, eA))) {
-  cat(if(grepl("missing|not found", o$message)) "<missing>" else o$message,
+  cat(if(inherits(o, "getMissingError")) "<missing>" else o$message,
  "\n", sep = "")
  }
  else {

src/main/envir.c

@@ -2138,9 +2138,13 @@ attribute_hidden SEXP do_get(SEXP call, SEXP op, SEXP args, SEXP rho)
 
  /* Search for the object */
  rval = findVar1mode(t1, genv, gmode, wants_S4, ginherits, PRIMVAL(op));
- if (rval == R_MissingArg)
- error(_("argument \"%s\" is missing, with no default"),
- CHAR(PRINTNAME(t1)));
+ if (rval == R_MissingArg) { // signal a *classed* error:
+ SEXP cond = R_makeErrorCondition(call, "getMissingError", NULL, 0,
+ _("argument \"%s\" is missing, with no default"), CHAR(PRINTNAME(t1)));
+ PROTECT(cond);
+ R_signalErrorCondition(cond, call);
+ UNPROTECT(1); /* cond; not reached */
+ }
 
  switch (PRIMVAL(op) ) {
  case 0: // exists(.) :