bugfix in CheckSEXPForJSRef and CheckForRefClass

gmbecker · Feb 2, 2013 · c8a17d7 · c8a17d7
1 parent a8d9683
commit c8a17d7
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 13 deletions.
diff --git a/R/NPAPI.R b/R/NPAPI.R
@@ -1,5 +1,3 @@
-setClass("NPObjectRef", contains="RCStructReference")
-setClass("NPVariantRef", contains="RCStructReference")
 
 NP_Invoke = function(...,
   plug = PluginInstance,

diff --git a/R/classes.R b/R/classes.R
@@ -3,6 +3,11 @@ setClass("JSValueRef", contains = "RCReference")
 setClass("NPNFunctionsRef", contains = "RCStructReference")
 setClass("PluginInstance", representation=representation(funcs = "NPNFunctionsRef"), contains="RCStructReference")
 
+setClass("NPObjectRef", contains="RCStructReference")
+setClass("NPVariantRef", contains="RCStructReference")
+
+setIs("NPVariantRef", "JSValueRef")
+
 if(FALSE)
 {
 setClass("NPObjectRef", contains = "RCStructReference")

diff --git a/inst/NPAPI/NPConversions.cpp b/inst/NPAPI/NPConversions.cpp
@@ -5,8 +5,12 @@ bool ConvertRToNP(SEXP val, NPP inst, NPNetscapeFuncs *funcs, NPVariant *ret, co
 
 //If it is a promise we need the actual value.  
   int err = 0;
+  int numprot = 0;
   if(TYPEOF(val) == PROMSXP)
-    val = rQueue.requestRCall(val, R_GlobalEnv, &err, inst);
+    {
+      PROTECT(val = rQueue.requestRCall(val, R_GlobalEnv, &err, inst));
+      numprot = 1;
+    }
   //Is it already a reference to an existing NP/JS object? If so just return that object!
   if (CheckSEXPForJSRef(val, inst))
     {
@@ -51,6 +55,8 @@ bool ConvertRToNP(SEXP val, NPP inst, NPNetscapeFuncs *funcs, NPVariant *ret, co
       MakeRRefForNP(val, inst, funcs, ret);
       break;
     }
+  if(numprot)
+    UNPROTECT(1);
   return true;
 }
 
@@ -691,15 +697,15 @@ bool CheckSEXPForJSRef(SEXP obj, NPP inst)
   ptr = CDR(ptr);
   SETCAR(ptr, obj);
   ptr = CDR(ptr);
-  //  SETCAR(ptr, ScalarString(mkChar("JSValueRef")));
   SETCAR(ptr, ScalarString(mkChar("JSValueRef")));
 
   PROTECT(ans = rQueue.requestRCall(call, R_GlobalEnv, &err, inst));
   bool ret;
-  if (ans == R_UnboundValue || ans == R_NilValue)
+  if (ans == R_UnboundValue || ans == R_NilValue || err)
     ret = 0;
   else
     {
+
       ret = LOGICAL(ans)[0];
       if(ret)
 	{fprintf(stderr, "\nR object contains JS reference.\n");fflush(stderr);}
@@ -724,7 +730,7 @@ bool checkForRefClass(SEXP obj)
   PROTECT(ans = R_tryEval(call, R_GlobalEnv, &err));
   if(err || !LOGICAL(ans)[0])
     ret = false;
-
+  UNPROTECT(2);
   return ret;
 }
 

diff --git a/src/NPConversions.cpp b/src/NPConversions.cpp
@@ -6,8 +6,12 @@ bool ConvertRToNP(SEXP val, NPP inst, NPNetscapeFuncs *funcs, NPVariant *ret, co
 
 //If it is a promise we need the actual value.  
   int err = 0;
+  int numprot = 0;
   if(TYPEOF(val) == PROMSXP)
-    val = R_tryEval(val, R_GlobalEnv, &err);
+    {
+      PROTECT(val = R_tryEval(val, R_GlobalEnv, &err));
+      numprot = 1;
+    }
   //Is it already a reference to an existing NP/JS object? If so just return that object!
   if (CheckSEXPForJSRef(val, inst))
     {
@@ -46,6 +50,8 @@ bool ConvertRToNP(SEXP val, NPP inst, NPNetscapeFuncs *funcs, NPVariant *ret, co
       MakeRRefForNP(val, inst, funcs, ret);
       break;
     }
+  if(numprot)
+    UNPROTECT(1);
   return true;
 }
 
@@ -584,18 +590,24 @@ bool CheckSEXPForJSRef(SEXP obj, NPP inst)
 {
 
   SEXP ans, call, ptr;
-  int err;
+  int err = 0;
   PROTECT(ptr = call= allocVector(LANGSXP, 3));
   SETCAR(ptr, Rf_install("is"));
   ptr = CDR(ptr);
   SETCAR(ptr, obj);
   ptr = CDR(ptr);
   SETCAR(ptr, ScalarString(mkChar("JSValueRef")));
-
   PROTECT(ans = R_tryEval(call, R_GlobalEnv, &err));
-  bool ret = LOGICAL(ans)[0];
-  if(ret)
-    {fprintf(stderr, "\nR object contains JS reference.\n");fflush(stderr);}
+
+  bool ret;
+  if (ans == R_UnboundValue || ans == R_NilValue || err)
+    ret = 0;
+  else
+    {
+      ret = LOGICAL(ans)[0];
+      if(ret)
+	{fprintf(stderr, "\nR object contains JS reference.\n");fflush(stderr);}
+    }
   UNPROTECT(2);
   return ret;
 
@@ -616,6 +628,6 @@ bool checkForRefClass(SEXP obj)
   PROTECT(ans = R_tryEval(call, R_GlobalEnv, &err));
   if(err || !LOGICAL(ans)[0])
     ret = false;
-
+  UNPROTECT(2);
   return ret;
 }