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

Fix overloading for non-pointers and NULL - R

Browse source
This commit is contained in:
William S Fulton 2018-12-30 13:46:51 +00:00
commit f181d20dd1
4 changed files with 66 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

49
Examples/test-suite/r/overload_null_runme.R Normal file
View file

@ -0,0 +1,49 @@
clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("overload_null", .Platform$dynlib.ext, sep=""))
source("overload_null.R")
cacheMetaData(1)
o <- Overload()
x <- X()
unittest(1, o$byval1(x))
unittest(2, o$byval1(NULL))
unittest(3, o$byval2(NULL))
unittest(4, o$byval2(x))
unittest(5, o$byref1(x))
unittest(6, o$byref1(NULL))
unittest(7, o$byref2(NULL))
unittest(8, o$byref2(x))
unittest(9, o$byconstref1(x))
unittest(10, o$byconstref1(NULL))
unittest(11, o$byconstref2(NULL))
unittest(12, o$byconstref2(x))
# const pointer references
# No SWIGTYPE *const& typemaps for R yet
#unittest(13, o$byval1cpr(x))
#unittest(14, o$byval1cpr(NULL))
#unittest(15, o$byval2cpr(NULL))
#unittest(16, o$byval2cpr(x))
# forward class declaration
unittest(17, o$byval1forwardptr(x))
unittest(18, o$byval1forwardptr(NULL))
unittest(19, o$byval2forwardptr(NULL))
unittest(20, o$byval2forwardptr(x))
unittest(21, o$byval1forwardref(x))
unittest(22, o$byval2forwardref(x))
q(save="no")

2
Lib/r/r.swg
View file

@ -3,9 +3,9 @@
%insert("header") "swiglabels.swg"
%insert("header") "swigerrors.swg"
%insert("init") "swiginit.swg"
%insert("runtime") "swigrun.swg"
%insert("runtime") "swigerrors.swg"
%insert("runtime") "rrun.swg"
%init %{

2
Lib/r/rrun.swg
View file

@ -278,7 +278,7 @@ SWIG_R_ConvertPtr(SEXP obj, void **ptr, swig_type_info *ty, int flags) {
if (!obj) return SWIG_ERROR;
if (obj == R_NilValue) {
if (ptr) *ptr = NULL;
return SWIG_OK;
return (flags & SWIG_POINTER_NO_NULL) ? SWIG_NullReferenceError : SWIG_OK;
}
vptr = R_ExternalPtrAddr(obj);

38
Source/Modules/r.cxx
View file

@ -1664,37 +1664,29 @@ void R::dispatchFunction(Node *n) {
Printf(stdout, "<rtypecheck>%s\n", tmcheck);
}
Printf(f->code, "%s(%s)",
j == 0? "" : " && ",
j == 0 ? "" : " && ",
tmcheck);
p = Getattr(p, "tmap:in:next");
continue;
}
// Below should be migrated into rtypecheck typemaps
if (tm) {
if (Strcmp(tm,"numeric")==0) {
Printf(f->code, "%sis.numeric(argv[[%d]])",
j == 0 ? "" : " && ",
j+1);
}
else if (Strcmp(tm,"integer")==0) {
Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))",
j == 0 ? "" : " && ",
j+1, j+1);
}
else if (Strcmp(tm,"character")==0) {
Printf(f->code, "%sis.character(argv[[%d]])",
j == 0 ? "" : " && ",
j+1);
}
else {
Printf(f->code, "%sextends(argtypes[%d], '%s')",
j == 0 ? "" : " && ",
j+1,
tm);
Printf(f->code, "%s", j == 0 ? "" : " && ");
if (Strcmp(tm, "numeric") == 0) {
Printf(f->code, "is.numeric(argv[[%d]])", j+1);
} else if (Strcmp(tm, "integer") == 0) {
Printf(f->code, "(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", j+1, j+1);
} else if (Strcmp(tm, "character") == 0) {
Printf(f->code, "is.character(argv[[%d]])", j+1);
} else {
if (SwigType_ispointer(Getattr(p, "type")))
Printf(f->code, "(extends(argtypes[%d], '%s') || is.null(argv[[%d]]))", j+1, tm, j+1);
else
Printf(f->code, "extends(argtypes[%d], '%s')", j+1, tm);
}
}
if (!SwigType_ispointer(Getattr(p, "type"))) {
Printf(f->code, " && length(argv[[%d]]) == 1",
j+1);
Printf(f->code, " && length(argv[[%d]]) == 1", j+1);
}
p = Getattr(p, "tmap:in:next");
}