jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Dont use the global namespace polluting methods in the R headers - provides Visual C++ support

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10109 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
William S Fulton 2007-11-11 20:26:58 +00:00
commit a80c41bef5
4 changed files with 63 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

10
Lib/r/r.swg
View file

@ -77,7 +77,7 @@ SWIG_InitializeModule(0);
%typemap(scheck) int %{ %typemap(scheck) int %{
if(length($input) > 1) { 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* %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 { %typemap(in,noblock=1) char {
$1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); $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"; char tmp[2] = "x";
tmp[0] = $1; 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 %typemap(out,noblock=1) int
"$result = ScalarInteger($1);"; "$result = Rf_ScalarInteger($1);";
%typemap(in,noblock=1) bool %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 %typemap(out,noblock=1) bool
"$result = ScalarLogical($1);"; "$result = Rf_ScalarLogical($1);";
%typemap(in,noblock=1) unsigned int, %typemap(in,noblock=1) unsigned int,
unsigned long, unsigned long,

22
Lib/r/rfragments.swg
View file

@ -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) #define SWIG_fail return Rf_ScalarLogical(NA_LOGICAL)
/* for raw pointers */ /* for raw pointers */
#define SWIG_ConvertPtr(oc, ptr, ty, flags) SWIG_R_ConvertPtr(oc, ptr, ty, flags) #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_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_NewPointerObj(ptr, ty, flags) SWIG_R_NewPointerObj(ptr, ty, flags)
#define SWIG_NewFunctionPtrObj(ptr, ty) SWIG_R_NewPointerObj(ptr, ty, 0) #define SWIG_NewFunctionPtrObj(ptr, ty) SWIG_R_NewPointerObj(ptr, ty, 0)
/* for raw packed data */ /* for raw packed data */
#define SWIG_ConvertPacked(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty) #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 */ /* for class or struct pointers */
#define SWIG_ConvertInstance(obj, pptr, ty, flags) SWIG_ConvertPtr(obj, pptr, 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) #define SWIG_NewInstanceObj(ptr, ty, flags) SWIG_NewPointerObj(ptr, ty, flags)
/* for C++ member pointers, ie, member methods */ /* for C++ member pointers, ie, member methods */
#define SWIG_ConvertMember(obj, ptr, sz, ty) SWIG_R_ConvertPacked(obj, ptr, sz, ty) #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 */ /* Runtime API */
@ -158,11 +158,11 @@ SWIG_FromCharPtrAndSize(const char* carray, size_t size)
if (!carray) return R_NilValue; if (!carray) return R_NilValue;
RVERSION26(return Rf_mkCharEnc(carray, size)); RVERSION26(return Rf_mkCharEnc(carray, size));
RVERSIONPRE26( RVERSIONPRE26(
PROTECT(t = allocVector(STRSXP, 1)); Rf_protect(t = Rf_allocVector(STRSXP, 1));
c = allocString(size); c = allocString(size);
strncpy(CHAR(c), carray, size); strncpy(CHAR(c), carray, size);
SET_STRING_ELT(t, 0, c); SET_STRING_ELT(t, 0, c);
UNPROTECT(1);) Rf_unprotect(1);)
return t; return t;
} }
} }

76
Lib/r/rrun.swg
View file

@ -1,14 +1,17 @@
/* Not really used yet. */ /* Remove global namespace pollution */
#if !defined(SWIG_NO_R_NO_REMAP)
#ifdef __cplusplus # define R_NO_REMAP
extern "C" {
#endif #endif
#include <Rdefines.h> #include <Rdefines.h>
#include <Rversion.h> #include <Rversion.h>
#include <stdlib.h> #include <stdlib.h>
#undef length
#ifdef __cplusplus
extern "C" {
#endif
#define SWIGR 1 #define SWIGR 1
#if R_VERSION >= R_Version(2,6,0) #if R_VERSION >= R_Version(2,6,0)
@ -61,11 +64,11 @@ R_SWIG_debug_getCallbackFunctionData()
p = p->previous; 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++) for(p = callbackFunctionDataStack, i = 0; i < n; p = p->previous, i++)
SET_VECTOR_ELT(ans, i, p->fun); SET_VECTOR_ELT(ans, i, p->fun);
UNPROTECT(1); Rf_unprotect(1);
return(ans); return(ans);
} }
@ -81,9 +84,9 @@ R_SWIG_pushCallbackFunctionData(SEXP fun, SEXP userData)
el->userData = userData; el->userData = userData;
el->previous = callbackFunctionDataStack; 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_R_pushCallbackFunctionData(SEXP fun, SEXP userData)
{ {
R_SWIG_pushCallbackFunctionData(fun, userData); R_SWIG_pushCallbackFunctionData(fun, userData);
return R_NilValue; return R_NilValue;
} }
SWIGRUNTIME RCallbackFunctionData * SWIGRUNTIME RCallbackFunctionData *
R_SWIG_getCallbackFunctionData() R_SWIG_getCallbackFunctionData()
{ {
if(!callbackFunctionDataStack) { if(!callbackFunctionDataStack) {
PROBLEM "Supposedly impossible error occurred in the SWIG callback mechanism." Rf_error("Supposedly impossible error occurred in the SWIG callback mechanism."
" No callback function data set." /* split across two strings to make more readable. */ " No callback function data set.");
ERROR;
} }
return callbackFunctionDataStack; return callbackFunctionDataStack;
@ -138,16 +140,16 @@ SWIGRUNTIME int
R_SWIG_checkInherits(SEXP obj, SEXP tag, const char *type) R_SWIG_checkInherits(SEXP obj, SEXP tag, const char *type)
{ {
SEXP e, val; 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(e, Rf_install("extends"));
SETCAR(CDR(e), mkString(CHAR(PRINTNAME(tag)))); SETCAR(CDR(e), Rf_mkString(CHAR(PRINTNAME(tag))));
SETCAR(CDR(CDR(e)), mkString(type)); SETCAR(CDR(CDR(e)), Rf_mkString(type));
val = R_tryEval(e, R_GlobalEnv, &check_err); val = R_tryEval(e, R_GlobalEnv, &check_err);
UNPROTECT(1); Rf_unprotect(1);
if(check_err) if(check_err)
return(0); return(0);
@ -163,28 +165,24 @@ R_SWIG_resolveExternalRef(SEXP arg, const char * const type, const char * const
SEXP orig = arg; SEXP orig = arg;
if(TYPEOF(arg) != EXTPTRSXP) if(TYPEOF(arg) != EXTPTRSXP)
arg = GET_SLOT(arg, mkString("ref")); arg = GET_SLOT(arg, Rf_mkString("ref"));
if(TYPEOF(arg) != EXTPTRSXP) { if(TYPEOF(arg) != EXTPTRSXP) {
PROBLEM "argument %s must be an external pointer (from an ExternalReference)", argName Rf_error("argument %s must be an external pointer (from an ExternalReference)", argName);
ERROR;
} }
ptr = R_ExternalPtrAddr(arg); ptr = R_ExternalPtrAddr(arg);
if(ptr == NULL && nullOk == (Rboolean) FALSE) { if(ptr == NULL && nullOk == (Rboolean) FALSE) {
PROBLEM "the external pointer (of type %s) for argument %s has value NULL", Rf_error("the external pointer (of type %s) for argument %s has value NULL", argName, type);
argName, type
ERROR;
} }
if(type[0] && R_ExternalPtrTag(arg) != Rf_install(type) && strcmp(type, "voidRef") if(type[0] && R_ExternalPtrTag(arg) != Rf_install(type) && strcmp(type, "voidRef")
&& !R_SWIG_checkInherits(orig, R_ExternalPtrTag(arg), type)) { && !R_SWIG_checkInherits(orig, R_ExternalPtrTag(arg), type)) {
PROBLEM "the external pointer for argument %s has tag %s, not the expected value %s", Rf_error("the external pointer for argument %s has tag %s, not the expected value %s",
argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type argName, CHAR(PRINTNAME(R_ExternalPtrTag(arg))), type);
ERROR;
} }
@ -195,12 +193,12 @@ SWIGRUNTIME void
R_SWIG_ReferenceFinalizer(SEXP el) R_SWIG_ReferenceFinalizer(SEXP el)
{ {
void *ptr = R_SWIG_resolveExternalRef(el, "", "<finalizer>", (Rboolean) 1); void *ptr = R_SWIG_resolveExternalRef(el, "", "<finalizer>", (Rboolean) 1);
fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr); fprintf(stderr, "In R_SWIG_ReferenceFinalizer for %p\n", ptr);
Rf_PrintValue(el); Rf_PrintValue(el);
if(ptr) { if(ptr) {
if(TYPEOF(el) != EXTPTRSXP) if(TYPEOF(el) != EXTPTRSXP)
el = GET_SLOT(el, mkString("ref")); el = GET_SLOT(el, Rf_mkString("ref"));
if(TYPEOF(el) == EXTPTRSXP) if(TYPEOF(el) == EXTPTRSXP)
R_ClearExternalPtr(el); R_ClearExternalPtr(el);
@ -222,15 +220,15 @@ SWIG_MakePtr(void *ptr, const char *typeName, R_SWIG_Owner owner)
if(typeName[0] == '_') if(typeName[0] == '_')
p = typeName + 1; p = typeName + 1;
PROTECT(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue)); Rf_protect(external = R_MakeExternalPtr(ptr, Rf_install(typeName), R_NilValue));
PROTECT(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName))); Rf_protect(r_obj = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
if(owner) if(owner)
R_RegisterCFinalizer(external, R_SWIG_ReferenceFinalizer); 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); return(r_obj);
} }
@ -242,11 +240,11 @@ R_SWIG_create_SWIG_R_Array(const char *typeName, SEXP ref, int len)
SEXP arr; SEXP arr;
/*XXX remove the char * cast when we can. MAKE_CLASS should be declared appropriately. */ /*XXX remove the char * cast when we can. MAKE_CLASS should be declared appropriately. */
PROTECT(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName))); Rf_protect(arr = NEW_OBJECT(MAKE_CLASS((char *) typeName)));
PROTECT(arr = R_do_slot_assign(arr, mkString("ref"), ref)); Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("ref"), ref));
PROTECT(arr = R_do_slot_assign(arr, mkString("dims"), ScalarInteger(len))); Rf_protect(arr = R_do_slot_assign(arr, Rf_mkString("dims"), Rf_ScalarInteger(len)));
UNPROTECT(3); Rf_unprotect(3);
return arr; return arr;
} }

21
Source/Modules/r.cxx
View file

@ -665,7 +665,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
Printf(f->def, ")\n{\n"); 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_nprotect++;\n");
Printf(f->code, "r_swig_cb_data->el = r_swig_cb_data->expr;\n\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", Printv(f->code, "\n",
"if(r_swig_cb_data->errorOccurred) {\n", "if(r_swig_cb_data->errorOccurred) {\n",
"R_SWIG_popCallbackFunctionData(1);\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, funName,
"\"\n", ")\");\n",
"ERROR;\n",
"}\n", "}\n",
NIL); NIL);
@ -748,7 +747,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
void R::init() { void R::init() {
UnProtectWrapupCode = 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(); SClassDefs = NewHash();
@ -2038,9 +2037,9 @@ int R::functionWrapper(Node *n) {
String *tmp = NewString(""); String *tmp = NewString("");
if(!isVoidReturnType) 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, numOutArgs + !isVoidReturnType,
isVoidReturnType ? 1 : 2); isVoidReturnType ? 1 : 2);
@ -2630,7 +2629,7 @@ int R::generateCopyRoutinesObsolete(Node *n) {
Printf(copyToC->def, "%sCopyToC = function(value, obj)\n{\n", name); 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); Wrapper_add_localv(toC, "_tmp_sexp", "SEXP", "_tmp_sexp", NIL);
@ -2686,8 +2685,8 @@ int R::generateCopyRoutinesObsolete(Node *n) {
replaceRClass(tm,elType); replaceRClass(tm,elType);
Printf(toR->code, "%s\nPROTECT(_tmp_sexp);\nr_nprotect++;\n", tm); Printf(toR->code, "%s\nRf_protect(_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, "Rf_protect(r_obj = R_do_slot_assign(r_obj, Rf_mkString(\"%s\"), _tmp_sexp));\nr_nprotect++;\n\n", elName);
} else { } else {
Printf(stderr, "*** Can't convert field %s in \n", elName); Printf(stderr, "*** Can't convert field %s in \n", elName);
} }
@ -2710,7 +2709,7 @@ int R::generateCopyRoutinesObsolete(Node *n) {
elName, tm, field); elName, tm, field);
#ifdef R_SWIG_VERBOSE #ifdef R_SWIG_VERBOSE
#endif #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); Delete(field);
} }
/* /*