Fix options(show.error.locations) to work with byte-code interpreter and

rationalize supported values.  Fix R_GetCurrentSrcref()'s counting of R
contexts to be compatible with traceback().  PR#18841, from Duncan Murdoch.


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

doc/NEWS.Rd

@@ -342,6 +342,14 @@
       \code{Rf_*()} as has been documented in
       \sQuote{Writing R Extensions} for a while, fixing \PR{18800}
       thanks to \I{Mikael Jagan} and \I{Suharto Anggono}.
+
+      \item \code{R_GetCurrentSrcref(skip)} now skips calls rather
+      than \code{srcref}s, consistent with counting items in the
+      \code{traceback()} display.  If \code{skip == NA_INTEGER},
+      it searches for the first \code{srcref}, starting at
+      the current evaluation state and proceeding through the
+      call stack; otherwise, it returns the \code{srcref}
+      of the requested entry from the call stack.
     }
   }
 
@@ -497,7 +505,18 @@
       \item \code{summary(<stl>)} (which prints directly) finally gets the
       same \code{digits} default as the formatting printing of default
       \code{summary()} method results, and it is documented explicitly.
-    }
+      
+      \item \code{options(show.error.locations = TRUE)} once
+      again shows the most recent known location when an 
+      error is reported.  Setting its value to \code{"bottom"} 
+      is no longer supported.  Numerical values are converted
+      to logical.
+      
+      \item C API function \code{R_GetCurrentSrcref(skip)} now
+      returns \code{srcref} entries correctly.  (Note that there
+      is also a change to the interpretation of \code{skip}; 
+      see the C-LEVEL API entry above.)
+     }
   }
 }
 

doc/manual/R-exts.texi

@@ -14342,13 +14342,18 @@ make these available to debuggers running C code:
 SEXP R_GetCurrentSrcref(int skip);
 @end example
 
-This function checks @code{R_Srcref} and the current evaluation stack
-for entries that contain source reference information.  The
-@code{skip} argument tells how many source references to skip before
-returning the @code{SEXP} of the @code{srcref} object, counting from
-the top of the stack.  If @code{skip < 0}, @code{abs(skip)} locations
-are counted up from the bottom of the stack. If too few or no source
-references are found, @code{NULL} is returned.
+This function checks the current evaluation stack
+for entries that contain source reference information. There
+are two modes of operation.
+If @code{skip == NA_INTEGER}, the @code{R_Srcref} entry is checked
+followed by entries in the call stack, until a @code{srcref} 
+is found.  Otherwise, the @code{skip} argument tells how many
+calls to skip (counting from the top of the stack) before
+returning the @code{SEXP} of the call's @code{srcref} object or
+@code{NULL} if that call did not have one.  If @code{skip < 0}, 
+@code{abs(skip)} locations are counted up from the bottom of the
+stack. If too few or no source references are found, @code{NULL}
+is returned.  
 
 @example
 SEXP R_GetSrcFilename(SEXP srcref);

src/library/base/man/options.Rd

@@ -394,13 +394,7 @@ getOption(x, default = NULL)
     \item{\code{show.error.locations}:}{Should source locations of
       errors be printed?  If set to \code{TRUE} or \code{"top"}, the
       source location that is highest on the stack (the most recent
-      call) will be printed.  \code{"bottom"} will print the location
-      of the earliest call found on the stack.
-
-      Integer values can select other entries.  The value \code{0}
-      corresponds to \code{"top"} and positive values count down the
-      stack from there.  The value \code{-1} corresponds to
-      \code{"bottom"} and negative values count up from there.
+      code with source information) will be printed.  
       }
 
     \item{\code{show.error.messages}:}{a logical.  Should error messages

src/main/errors.c

@@ -1,6 +1,6 @@
 /*
  *  R : A Computer Language for Statistical Data Analysis
- *  Copyright (C) 1995--2024  The R Core Team.
+ *  Copyright (C) 1995--2025  The R Core Team.
  *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
@@ -795,22 +795,18 @@ verrorcall_dflt(SEXP call, const char *format, va_list ap)
 	char *head = _("Error in "), *tail = "\n  ";
 	SEXP srcloc = R_NilValue; // -Wall
 	size_t len = 0;	// indicates if srcloc has been set
-	int protected = 0, skip = NA_INTEGER;
+	int protected = 0, show = 0;
 	SEXP opt = GetOption1(install("show.error.locations"));
-	if (!isNull(opt)) {
-	    if (TYPEOF(opt) == STRSXP && length(opt) == 1) {
-		if (pmatch(ScalarString(mkChar("top")), opt, 0)) skip = 0;
-		else if (pmatch(ScalarString(mkChar("bottom")), opt, 0)) skip = -1;
-	    } else if (TYPEOF(opt) == LGLSXP)
-		skip = asLogical(opt) == 1 ? 0 : NA_INTEGER;
-	    else
-		skip = asInteger(opt);
-	}
+	if (length(opt) == 1 &&
+	    (asLogical(opt) == 1 ||
+	     (TYPEOF(opt) == STRSXP &&
+	      pmatch(ScalarString(mkChar("top")), opt, 0))))
+	    	show = 1;
 
 	const char *dcall = CHAR(STRING_ELT(deparse1s(call), 0));
 	Rsnprintf_mbcs(tmp2, BUFSIZE,  "%s", head);
-	if (skip != NA_INTEGER) {
-	    PROTECT(srcloc = GetSrcLoc(R_GetCurrentSrcref(skip)));
+	if (show) {
+	    PROTECT(srcloc = GetSrcLoc(R_GetCurrentSrcref(NA_INTEGER)));
 	    protected++;
 	    len = strlen(CHAR(STRING_ELT(srcloc, 0)));
 	    if (len)
@@ -1504,6 +1500,15 @@ static void R_PrintDeferredWarnings(void)
 	PrintWarnings();
     }
 }
+
+/* if srcref indicates it is in bytecode, it needs a fixup */
+static SEXP fixBCSrcref(SEXP srcref, RCNTXT *c)
+{
+    if (srcref == R_InBCInterpreter)
+	srcref = R_findBCInterpreterSrcref(c);
+    return srcref;
+}
+
 /*
  * Return the traceback without deparsing the calls
  */
@@ -2342,25 +2347,44 @@ SEXP
 R_GetCurrentSrcref(int skip)
 {
     RCNTXT *c = R_GlobalContext;
-    SEXP srcref = R_Srcref;
+    SEXP srcref;
+    int keep_looking = skip == NA_INTEGER;
+    if (keep_looking) skip = 0;
     if (skip < 0) { /* to count up from the bottom, we need to count them all first */
 	while (c) {
-	    if (srcref && srcref != R_NilValue)
+	    if (c->callflag & (CTXT_FUNCTION | CTXT_BUILTIN))
 		skip++;
-	    srcref = c->srcref;
 	    c = c->nextcontext;
 	};
 	if (skip < 0) return R_NilValue; /* not enough there */
 	c = R_GlobalContext;
-	srcref = R_Srcref;
     }
-    while (c && (skip || !srcref || srcref == R_NilValue)) {
-	if (srcref && srcref != R_NilValue)
+
+    /* If skip = NA, try current active srcref first. */
+
+    if (keep_looking) {
+    	srcref = R_getCurrentSrcref();
+        if (srcref && !isNull(srcref))
+    	  return srcref;
+    }
+
+    /* Go to the first call */
+    while (c && !(c->callflag & (CTXT_FUNCTION | CTXT_BUILTIN)))
+    	c = c->nextcontext;
+
+    /* Now skip enough calls, regardless of srcref presence */
+    while (c && skip) {
+    	if (c->callflag & (CTXT_FUNCTION | CTXT_BUILTIN))
 	    skip--;
-	srcref = c->srcref;
 	c = c->nextcontext;
     }
-    if (skip || !srcref)
+    /* Now get the next srcref.  If skip was not NA, don't
+       keep looking. */
+    do {
+        srcref = fixBCSrcref(c->srcref, c);
+        c = c->nextcontext;
+    } while (keep_looking && c && !(srcref && !isNull(srcref)));
+    if (!srcref)
 	srcref = R_NilValue;
     return srcref;
 }