don't suspend sessions with external pointers (fixes #1696)

src/cpp/session/SessionConsoleInput.cpp

@@ -24,6 +24,7 @@
 #include "modules/SessionConsole.hpp"
 
 #include "modules/connections/SessionConnections.hpp"
+#include "modules/environment/SessionEnvironment.hpp"
 #include "modules/overlay/SessionOverlay.hpp"
 
 #include <session/SessionModuleContext.hpp>
@@ -89,6 +90,7 @@ bool canSuspend(const std::string& prompt)
    return !main_process::haveActiveChildren() && 
           modules::connections::isSuspendable() &&
           modules::overlay::isSuspendable() &&
+          modules::environment::isSuspendable() &&
           rstudio::r::session::isSuspendable(prompt);
 }
 

src/cpp/session/modules/SessionEnvironment.R

@@ -432,7 +432,7 @@
    obj <- get(objName, env)
    # objects containing null external pointers can crash when
    # evaluated--display generically (see case 4092)
-   hasNullPtr <- .rs.hasNullExternalPointer(obj)
+   hasNullPtr <- .Call("rs_hasExternalPointer", obj, TRUE)
    if (hasNullPtr) 
    {
       val <- "<Object with null pointer>"
@@ -643,32 +643,4 @@
    .rs.valueContents(get(objName, env));
 })
 
-# attempt to determine whether the given object contains a null external
-# pointer
-.rs.addFunction("hasNullExternalPointer", function(obj)
-{
-   if (isS4(obj)) 
-   {
-      # this is an S4 object; recursively check its slots for null pointers
-      any(sapply(slotNames(obj), function(name) {
-         hasNullPtr <- FALSE
-         # it's possible to cheat the S4 object system and destroy the contents
-         # of a slot via attr<- assignments; in this case slotNames will
-         # contain slots that don't exist, and trying to access those slots 
-         # throws an error.
-         tryCatch({
-           hasNullPtr <- .rs.hasNullExternalPointer(slot(obj, name))
-           }, 
-           error = function(err) {})
-         hasNullPtr
-      }))
-   } 
-   else
-   {
-      # check if object itself is a null external pointer
-      .rs.isNullExternalPointer(obj)
-   }
-})
-
-
 

src/cpp/session/modules/environment/SessionEnvironment.cpp

@@ -112,6 +112,57 @@ bool handleRBrowseEnv(const core::FilePath& filePath)
    }
 }
 
+bool hasExternalPtr(SEXP env,      // environment to search for external pointers
+                    bool nullPtr,  // whether to look for NULL pointers 
+                    int level = 5) // maximum recursion depth (envs can have self-ref loops)
+{
+   // list the contents of this environment
+   std::vector<r::sexp::Variable> vars;
+   r::sexp::Protect rProtect;
+   r::sexp::listEnvironment(env, 
+                            true,  // include all values
+                            false, // don't include last dot
+                            &rProtect, &vars);
+
+   // check for external pointers
+   for (std::vector<r::sexp::Variable>::iterator it = vars.begin(); it != vars.end(); it++)
+   {
+      if (r::sexp::isExternalPointer(it->second) && 
+          r::sexp::isNullExternalPointer(it->second) == nullPtr)
+      {
+         return true;
+      }
+
+      if (r::sexp::isEnvironment(it->second) && level > 0)
+      {
+         // if this object is itself an environment, check it recursively for external pointers. 
+         // (we do this only if there's sufficient recursion depth remaining)
+         if (hasExternalPtr(it->second, nullPtr, level - 1))
+            return true;
+      }
+   }
+
+   return false;
+}
+
+SEXP rs_hasExternalPointer(SEXP objSEXP, SEXP nullSEXP)
+{
+   bool nullPtr = r::sexp::asLogical(nullSEXP);
+   r::sexp::Protect protect;
+   bool hasPtr = false;
+   if (r::sexp::isExternalPointer(objSEXP))
+   {
+      // object is an external pointer itself
+      hasPtr = r::sexp::isNullExternalPointer(objSEXP) == nullPtr;
+   }
+   else if (r::sexp::isEnvironment(objSEXP))
+   {
+      // object is an environment; check it for external pointers
+      hasPtr = hasExternalPtr(objSEXP, nullPtr);
+   }
+   return r::sexp::create(hasPtr, &protect);
+}
+
 // Construct a simulated source reference from a context containing a
 // function being debugged, and either the context containing the current
 // invocation or a string containing the last debug ouput from R.
@@ -944,6 +995,12 @@ SEXP rs_isBrowserActive()
    return r::sexp::create(s_browserActive, &protect);
 }
 
+bool isSuspendable()
+{
+   // suppress suspension if any object has a live external pointer; these can't be restored
+   return !hasExternalPtr(R_GlobalEnv, false);
+}
+
 Error initialize()
 {
    // store on the heap so that the destructor is never called (so we
@@ -975,6 +1032,8 @@ Error initialize()
    methodDef.numArgs = 3;
    r::routines::addCallMethod(methodDef);
 
+   RS_REGISTER_CALL_METHOD(rs_hasExternalPointer, 2);
+
    // subscribe to events
    using boost::bind;
    using namespace session::module_context;

src/cpp/session/modules/environment/SessionEnvironment.hpp

@@ -33,6 +33,8 @@ core::json::Value environmentStateAsJson();
 
 bool monitoring();
 
+bool isSuspendable();
+
 core::Error initialize();
 
 } // namespace environment