The R Project SVN – R – Diff – /trunk/src/main/dotcode.c

      Original code by Jean Meloche <jean@stat.ubc.ca> */
 typedef SEXP (*R_ExternalRoutine)(SEXP);
 typedef SEXP (*R_ExternalRoutine2)(SEXP, SEXP, SEXP, SEXP);
+static void check_retval(SEXP call, SEXP val)
+{
+    static int inited = FALSE;
+    static int check = FALSE;
+    if (! inited) {
+	inited = TRUE;
+	const char *p = getenv("_R_CHECK_DOTCODE_RETVAL_");
+	if (p != NULL && StringTrue(p))
+	    check = TRUE;
+    }
+    if (check) {
+	if (val == NULL)
+	    errorcall(call, "NULL return value");
+	else if (val < (SEXP) 16)
+	    errorcall(call, "WEIRD RETURN VALUE");
+    }
+}
 SEXP attribute_hidden do_External(SEXP call, SEXP op, SEXP args, SEXP env)
+{
     DL_FUNC ofun = NULL;
     SEXP retval;
     R_RegisteredNativeSymbol symbol = {R_EXTERNAL_SYM, {NULL}, NULL};
     } else {
 	R_ExternalRoutine fun = (R_ExternalRoutine) ofun;
 	retval = fun(args);
+    }
     vmaxset(vmax);
+    check_retval(call, retval);
     return retval;
+}
 #ifdef __cplusplus
 typedef SEXP (*VarFun)(...);
 	    R_Suicide("compiler constants were modified (in .Call?)!\n");
+	}
 	UNPROTECT(nargs + 1);
+    }
     vmaxset(vmax);
+    check_retval(call, retval);
     return retval;
+}
 /*  Call dynamically loaded "internal" graphics functions
     .External.graphics (used in graphics) and  .Call.graphics (used in grid).
 	if (!GEcheckState(dd))
 	    errorcall(call, _("invalid graphics state"));
 	GErecordGraphicOperation(op, args, dd);
+    }
     UNPROTECT(1);
+    check_retval(call, retval);
     return retval;
+}
 SEXP attribute_hidden do_dotcallgr(SEXP call, SEXP op, SEXP args, SEXP env)
+{
 	if (!GEcheckState(dd))
 	    errorcall(call, _("invalid graphics state"));
 	GErecordGraphicOperation(op, args, dd);
+    }
     UNPROTECT(1);
+    check_retval(call, retval);
     return retval;
+}
 static SEXP
 Rf_getCallingDLL(void)

The R Project SVN R

(root)/trunk/src/main/dotcode.c @ 77458 – Rev 76548 → 77354