diff --git a/Lib/r/r.swg b/Lib/r/r.swg index f4b2adb2c..420d2f302 100644 --- a/Lib/r/r.swg +++ b/Lib/r/r.swg @@ -77,7 +77,7 @@ SWIG_InitializeModule(0); %typemap(scheck) int %{ if(length($input) > 1) { - warning("using only the first element of $input") + Rf_warning("using only the first element of $input") } %} @@ -141,7 +141,7 @@ strcpy($1, ""); %} %typemap(out,noblock=1) char* - { $result = $1 ? mkString(%reinterpret_cast($1,char *)) : R_NilValue; } + { $result = $1 ? Rf_mkString(%reinterpret_cast($1,char *)) : R_NilValue; } %typemap(in,noblock=1) char { $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); @@ -151,7 +151,7 @@ $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); { char tmp[2] = "x"; tmp[0] = $1; - $result = mkString(tmp); + $result = Rf_mkString(tmp); } @@ -160,7 +160,7 @@ $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); } %typemap(out,noblock=1) int - "$result = ScalarInteger($1);"; + "$result = Rf_ScalarInteger($1);"; %typemap(in,noblock=1) bool @@ -168,7 +168,7 @@ $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); %typemap(out,noblock=1) bool - "$result = ScalarLogical($1);"; + "$result = Rf_ScalarLogical($1);"; %typemap(in,noblock=1) unsigned int, unsigned long, diff --git a/Lib/r/rfragments.swg b/Lib/r/rfragments.swg index f6a78bf75..5d8455cf3 100644 --- a/Lib/r/rfragments.swg +++ b/Lib/r/rfragments.swg @@ -1,24 +1,24 @@ -#define SWIG_Error(code, msg) warning(msg); return Rf_ScalarLogical(NA_LOGICAL) +#define SWIG_Error(code, msg) Rf_warning(msg); return Rf_ScalarLogical(NA_LOGICAL) #define SWIG_fail return Rf_ScalarLogical(NA_LOGICAL) /* for raw pointers */ -#define SWIG_ConvertPtr(oc, ptr, ty, flags) SWIG_R_ConvertPtr(oc, ptr, ty, flags) -#define SWIG_ConvertFunctionPtr(oc, ptr, ty) SWIG_R_ConvertPtr(oc, ptr, ty, 0) -#define SWIG_NewPointerObj(ptr, ty, flags) SWIG_R_NewPointerObj(ptr, ty, flags) -#define SWIG_NewFunctionPtrObj(ptr, ty) SWIG_R_NewPointerObj(ptr, ty, 0) +#define SWIG_ConvertPtr(oc, ptr, ty, flags) SWIG_R_ConvertPtr(oc, ptr, ty, flags) +#define SWIG_ConvertFunctionPtr(oc, ptr, ty) SWIG_R_ConvertPtr(oc, ptr, ty, 0) +#define SWIG_NewPointerObj(ptr, ty, flags) SWIG_R_NewPointerObj(ptr, ty, flags) +#define SWIG_NewFunctionPtrObj(ptr, ty) SWIG_R_NewPointerObj(ptr, ty, 0) /* for raw packed data */ #define SWIG_ConvertPacked(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty) -#define SWIG_NewPackedObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty) +#define SWIG_NewPackedObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty) /* for class or struct pointers */ -#define SWIG_ConvertInstance(obj, pptr, ty, flags) SWIG_ConvertPtr(obj, pptr, ty, flags) -#define SWIG_NewInstanceObj(ptr, ty, flags) SWIG_NewPointerObj(ptr, ty, flags) +#define SWIG_ConvertInstance(obj, pptr, ty, flags) SWIG_ConvertPtr(obj, pptr, ty, flags) +#define SWIG_NewInstanceObj(ptr, ty, flags) SWIG_NewPointerObj(ptr, ty, flags) /* for C++ member pointers, ie, member methods */ #define SWIG_ConvertMember(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty) -#define SWIG_NewMemberObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty) +#define SWIG_NewMemberObj(ptr, sz, ty) SWIG_R_NewPackedObj(ptr, sz, ty) /* Runtime API */ @@ -158,11 +158,11 @@ SWIG_FromCharPtrAndSize(const char* carray, size_t size) if (!carray) return R_NilValue; RVERSION26(return Rf_mkCharEnc(carray, size)); RVERSIONPRE26( - PROTECT(t = allocVector(STRSXP, 1)); + Rf_protect(t = Rf_allocVector(STRSXP, 1)); c = allocString(size); strncpy(CHAR(c), carray, size); SET_STRING_ELT(t, 0, c); - UNPROTECT(1);) + Rf_unprotect(1);) return t; } } diff --git a/Lib/r/rrun.swg b/Lib/r/rrun.swg index 4466aeebf..459d74913 100644 --- a/Lib/r/rrun.swg +++ b/Lib/r/rrun.swg @@ -1,14 +1,17 @@ -/* Not really used yet. */ - -#ifdef __cplusplus -extern "C" { +/* Remove global namespace pollution */ +#if !defined(SWIG_NO_R_NO_REMAP) +# define R_NO_REMAP #endif #include #include #include -#undef length + +#ifdef __cplusplus +extern "C" { +#endif + #define SWIGR 1 #if R_VERSION >= R_Version(2,6,0) @@ -61,11 +64,11 @@ R_SWIG_debug_getCallbackFunctionData() p = p->previous; } - PROTECT(ans = Rf_allocVector(VECSXP, n)); + Rf_protect(ans = Rf_allocVector(VECSXP, n)); for(p = callbackFunctionDataStack, i = 0; i < n; p = p->previous, i++) SET_VECTOR_ELT(ans, i, p->fun); - UNPROTECT(1); + Rf_unprotect(1); return(ans); } @@ -81,9 +84,9 @@ R_SWIG_pushCallbackFunctionData(SEXP fun, SEXP userData) el->userData = userData; el->previous = callbackFunctionDataStack; - callbackFunctionDataStack = el; + callbackFunctionDataStack = el; - return(el); + return(el); } @@ -91,16 +94,15 @@ SWIGRUNTIME SEXP R_SWIG_R_pushCallbackFunctionData(SEXP fun, SEXP userData) { R_SWIG_pushCallbackFunctionData(fun, userData); - return R_NilValue; + return R_NilValue; } SWIGRUNTIME RCallbackFunctionData * R_SWIG_getCallbackFunctionData() { if(!callbackFunctionDataStack) { - PROBLEM "Supposedly impossible error occurred in the SWIG callback mechanism." - " No callback function data set." /* split across two strings to make more readable. */ - ERROR; + Rf_error("Supposedly impossible error occurred in the SWIG callback mechanism." + " No callback function data set."); } return callbackFunctionDataStack; @@ -138,16 +140,16 @@ SWIGRUNTIME int R_SWIG_checkInherits(SEXP obj, SEXP tag, const char *type) { SEXP e, val; - int check_err = 0; + int check_err = 0; - PROTECT(e = Rf_allocVector(LANGSXP, 3)); + Rf_protect(e = Rf_allocVector(LANGSXP, 3)); SETCAR(e, Rf_install("extends")); - SETCAR(CDR(e), mkString(CHAR(PRINTNAME(tag)))); - SETCAR(CDR(CDR(e)), mkString(type)); + SETCAR(CDR(e), Rf_mkString(CHAR(PRINTNAME(tag)))); + SETCAR(CDR(CDR(e)), Rf_mkString(type)); val = R_tryEval(e, R_GlobalEnv, &check_err); - UNPROTECT(1); + Rf_unprotect(1); if(check_err) return(0); @@ -163,28 +165,24 @@ R_SWIG_resolveExternalRef(SEXP arg, const char * const type, const char * const SEXP orig = arg; if(TYPEOF(arg) != EXTPTRSXP) - arg = GET_SLOT(arg, mkString("ref")); + arg = GET_SLOT(arg, Rf_mkString("ref")); if(TYPEOF(arg) != EXTPTRSXP) { - PROBLEM "argument %s must be an external pointer (from an ExternalReference)", argName - ERROR; + Rf_error("argument %s must be an external pointer (from an ExternalReference)", argName); } ptr = R_ExternalPtrAddr(arg); if(ptr == NULL && nullOk == (Rboolean) FALSE) { - PROBLEM "the external pointer (of type %s) for argument %s has value NULL", - argName, type - ERROR; + Rf_error("the external pointer (of type %s) for argument %s has value NULL", argName, type); } if(type[0] && R_ExternalPtrTag(arg) != Rf_install(type) && strcmp(type, "voidRef") - && !R_SWIG_checkInherits(orig, R_ExternalPtrTag(arg), type)) { - PROBLEM "the external pointer for argument %s has tag %s, not the expected value %s", - argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type - ERROR; + && !R_SWIG_checkInherits(orig, R_ExternalPtrTag(arg), type)) { + Rf_error("the external pointer for argument %s has tag %s, not the expected value %s", + argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type); } @@ -195,12 +193,12 @@ SWIGRUNTIME void R_SWIG_ReferenceFinalizer(SEXP el) { void *ptr = R_SWIG_resolveExternalRef(el, "", "", (Rboolean) 1); -fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr); -Rf_PrintValue(el); + fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr); + Rf_PrintValue(el); if(ptr) { if(TYPEOF(el) != EXTPTRSXP) - el = GET_SLOT(el, mkString("ref")); + el = GET_SLOT(el, Rf_mkString("ref")); if(TYPEOF(el) == EXTPTRSXP) R_ClearExternalPtr(el); @@ -222,15 +220,15 @@ SWIG_MakePtr(void *ptr, const char *typeName, R_SWIG_Owner owner) if(typeName[0] == '_') p = typeName + 1; - PROTECT(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue)); - PROTECT(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName))); + Rf_protect(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue)); + Rf_protect(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName))); if(owner) R_RegisterCFinalizer(external, R_SWIG_ReferenceFinalizer); - r_obj = SET_SLOT(r_obj, mkString((char *) "ref"), external); + r_obj = SET_SLOT(r_obj, Rf_mkString((char *) "ref"), external); - UNPROTECT(2); + Rf_unprotect(2); return(r_obj); } @@ -242,11 +240,11 @@ R_SWIG_create_SWIG_R_Array(const char *typeName, SEXP ref, int len) SEXP arr; /*XXX remove the char * cast when we can. MAKE_CLASS should be declared appropriately. */ - PROTECT(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName))); - PROTECT(arr = R_do_slot_assign(arr, mkString("ref"), ref)); - PROTECT(arr = R_do_slot_assign(arr, mkString("dims"), ScalarInteger(len))); + Rf_protect(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName))); + Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("ref"), ref)); + Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("dims"), Rf_ScalarInteger(len))); - UNPROTECT(3); + Rf_unprotect(3); return arr; } diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx index eeb6fbbe2..58496c068 100644 --- a/Source/Modules/r.cxx +++ b/Source/Modules/r.cxx @@ -665,7 +665,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { Printf(f->def, ")\n{\n"); - Printf(f->code, "PROTECT(%s->expr = allocVector(LANGSXP, %d));\n", lvar, nargs + 1); + Printf(f->code, "Rf_protect(%s->expr = Rf_allocVector(LANGSXP, %d));\n", lvar, nargs + 1); Printf(f->code, "r_nprotect++;\n"); Printf(f->code, "r_swig_cb_data->el = r_swig_cb_data->expr;\n\n"); @@ -684,10 +684,9 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { Printv(f->code, "\n", "if(r_swig_cb_data->errorOccurred) {\n", "R_SWIG_popCallbackFunctionData(1);\n", - "PROBLEM \"error in calling R function as a function pointer (", + "Rf_error(\"error in calling R function as a function pointer (", funName, - "\"\n", - "ERROR;\n", + ")\");\n", "}\n", NIL); @@ -748,7 +747,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { void R::init() { UnProtectWrapupCode = - NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect) UNPROTECT(r_nprotect);\n\n"); + NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect) Rf_unprotect(r_nprotect);\n\n"); SClassDefs = NewHash(); @@ -2038,9 +2037,9 @@ int R::functionWrapper(Node *n) { String *tmp = NewString(""); if(!isVoidReturnType) - Printf(tmp, "PROTECT(r_ans);\n"); + Printf(tmp, "Rf_protect(r_ans);\n"); - Printf(tmp, "PROTECT(R_OutputValues = NEW_LIST(%d));\nr_nprotect += %d;\n", + Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n", numOutArgs + !isVoidReturnType, isVoidReturnType ? 1 : 2); @@ -2630,7 +2629,7 @@ int R::generateCopyRoutinesObsolete(Node *n) { Printf(copyToC->def, "%sCopyToC = function(value, obj)\n{\n", name); - Printf(toR->code, "PROTECT(r_obj = NEW_OBJECT(MAKE_CLASS(\"%s\")));\nr_nprotect++;\n\n", name); + Printf(toR->code, "Rf_protect(r_obj = NEW_OBJECT(MAKE_CLASS(\"%s\")));\nr_nprotect++;\n\n", name); Wrapper_add_localv(toC, "_tmp_sexp", "SEXP", "_tmp_sexp", NIL); @@ -2686,8 +2685,8 @@ int R::generateCopyRoutinesObsolete(Node *n) { replaceRClass(tm,elType); - Printf(toR->code, "%s\nPROTECT(_tmp_sexp);\nr_nprotect++;\n", tm); - Printf(toR->code, "PROTECT(r_obj = R_do_slot_assign(r_obj, mkString(\"%s\"), _tmp_sexp));\nr_nprotect++;\n\n", elName); + Printf(toR->code, "%s\nRf_protect(_tmp_sexp);\nr_nprotect++;\n", tm); + Printf(toR->code, "Rf_protect(r_obj = R_do_slot_assign(r_obj, Rf_mkString(\"%s\"), _tmp_sexp));\nr_nprotect++;\n\n", elName); } else { Printf(stderr, "*** Can't convert field %s in \n", elName); } @@ -2710,7 +2709,7 @@ int R::generateCopyRoutinesObsolete(Node *n) { elName, tm, field); #ifdef R_SWIG_VERBOSE #endif - Printf(toC->code, "_tmp_sexp = GET_SLOT(sobj, mkString(\"%s\"));\n%s\n\n", elName, tm); + Printf(toC->code, "_tmp_sexp = GET_SLOT(sobj, Rf_mkString(\"%s\"));\n%s\n\n", elName, tm); Delete(field); } /*