Dont use the global namespace polluting methods in the R headers - provides Visual C++ support
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
parent
7bbf5d66d1
commit
a80c41bef5
4 changed files with 63 additions and 66 deletions
10
Lib/r/r.swg
10
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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 <Rdefines.h>
|
||||
#include <Rversion.h>
|
||||
#include <stdlib.h>
|
||||
#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, "", "<finalizer>", (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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
/*
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue