Merge branch 'RMemberListTrialSimplify2019'
* RMemberListTrialSimplify2019:
ENH R abstract_access_runme
ENH R accessor processing test
Removed some remaining commented sections
moved registration routine and use swig_name_get
calling Swig_name_setget
Used Swig_name_register so that Swig_name_wrapper produces the correct name without a separate replace call.
Removed last instance of using Strcmp to check for a set/get method. Replaced with check for flag.
Alternative version of using memberlist processing. This clarifies the logic within OutputMemberReferenceMethod by filtering the lists into classes, rather than doing it internally. Code isn't any shorter.
commenting out unused code
first pass at removing string comparisons for set/get methods
trial changing member list processing
diff --git a/Examples/test-suite/r/abstract_access_runme.R b/Examples/test-suite/r/abstract_access_runme.R
new file mode 100644
index 0000000..f6fb409
--- /dev/null
+++ b/Examples/test-suite/r/abstract_access_runme.R
@@ -0,0 +1,74 @@
+clargs <- commandArgs(trailing=TRUE)
+source(file.path(clargs[1], "unittest.R"))
+
+dyn.load(paste("abstract_access", .Platform$dynlib.ext, sep=""))
+source("abstract_access.R")
+
+dd <- D()
+unittest(1, dd$z())
+unittest(1, dd$do_x())
+
+## Original version allowed dd$z <- 2
+tryCatch({
+ dd$z <- 2
+ # force an error if the previous line doesn't raise an exception
+ stop("Test Failure A")
+}, error = function(e) {
+ if (e$message == "Test Failure A") {
+ # Raise the error again to cause a failed test
+ stop(e)
+ }
+ message("Correct - no dollar assignment method found")
+}
+)
+
+tryCatch({
+ dd[["z"]] <- 2
+ # force an error if the previous line doesn't raise an exception
+ stop("Test Failure B")
+}, error = function(e) {
+ if (e$message == "Test Failure B") {
+ # Raise the error again to cause a failed test
+ stop(e)
+ }
+ message("Correct - no dollar assignment method found")
+}
+)
+
+## The methods are attached to the parent class - see if we can get
+## them
+tryCatch({
+ m1 <- getMethod('$', "_p_A")
+}, error = function(e) {
+ stop("No $ method found - there should be one")
+}
+)
+
+## These methods should not be present
+## They correspond to the tests that are expected
+## to fail above.
+tryCatch({
+ m2 <- getMethod('$<-', "_p_A")
+ # force an error if the previous line doesn't raise an exception
+ stop("Test Failure C")
+}, error = function(e) {
+ if (e$message == "Test Failure C") {
+ # Raise the error again to cause a failed test
+ stop(e)
+ }
+ message("Correct - no dollar assignment method found")
+}
+)
+
+tryCatch({
+ m3 <- getMethod('[[<-', "_p_A")
+ # force an error if the previous line doesn't raise an exception
+ stop("Test Failure D")
+}, error = function(e) {
+ if (e$message == "Test Failure D") {
+ # Raise the error again to cause a failed test
+ stop(e)
+ }
+ message("Correct - no list assignment method found")
+}
+)
diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx
index bb43dad..2ad377a 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -36,11 +36,6 @@
if(Strncmp(b, "struct ", 7) == 0)
Replace(b, "struct ", "", DOH_REPLACE_FIRST);
- /* Printf(stdout, "<getRTypeName> %s,base = %s\n", t, b);
- for(i = 0; i < Len(els); i++)
- Printf(stdout, "%d) %s, ", i, Getitem(els,i));
- Printf(stdout, "\n"); */
-
for(i = 0; i < Len(els); i++) {
String *el = Getitem(els, i);
if(Strcmp(el, "p.") == 0 || Strncmp(el, "a(", 2) == 0) {
@@ -56,13 +51,6 @@
Insert(tmp, 0, retName);
return tmp;
- /*
- if(count)
- return(b);
-
- Delete(b);
- return(NewString(""));
- */
}
/* --------------------------------------------------------------
@@ -285,11 +273,16 @@
int generateCopyRoutines(Node *n);
int DumpCode(Node *n);
- int OutputMemberReferenceMethod(String *className, int isSet, List *el, File *out);
+ int OutputMemberReferenceMethod(String *className, int isSet,
+ List *memberList, List *nameList,
+ List *typeList, File *out);
+#if 0
+ // not used
int OutputArrayMethod(String *className, List *el, File *out);
int OutputClassMemberTable(Hash *tb, File *out);
int OutputClassMethodsTable(File *out);
int OutputClassAccessInfo(Hash *tb, File *out);
+#endif
int defineArrayAccessors(SwigType *type);
@@ -334,10 +327,14 @@
void addAccessor(String *memberName, Wrapper *f,
- String *name, int isSet = -1);
+ String *name, String *methodSetGet);
static int getFunctionPointerNumArgs(Node *n, SwigType *tt);
+ // filtering of class member lists by function type. Used in constructing accessors
+ // are we allowed to use stl style functors to customise this?
+ List* filterMemberList(List *class_member_function_types, List *class_member_other, String *R_MEMBER, bool equal);
+
protected:
bool copyStruct;
bool memoryProfile;
@@ -367,11 +364,20 @@
String *member_name;
String *class_name;
+ String *R_MEMBER_NORMAL;
+ String *R_MEMBER_SET;
+ String *R_MEMBER_GET;
int processing_class_member_function;
- List *class_member_functions;
- List *class_member_set_functions;
-
+ // List *class_member_functions;
+ // List *class_member_set_functions;
+ // Spread out the lists so that they are simpler to process
+ // by storing the type of the method (i.e. set, get or nothing)
+ // and having separate lists for name, membername and wrapper
+ List *class_member_function_types;
+ List *class_member_function_names;
+ List *class_member_function_membernames;
+ List *class_member_function_wrappernames;
/* */
Hash *ClassMemberTable;
Hash *ClassMethodsTable;
@@ -429,9 +435,14 @@
processing_member_access_function(0),
member_name(0),
class_name(0),
+ R_MEMBER_NORMAL(NewString("normal")),
+ R_MEMBER_SET(NewString("set")),
+ R_MEMBER_GET(NewString("get")),
processing_class_member_function(0),
- class_member_functions(0),
- class_member_set_functions(0),
+ class_member_function_types(0),
+ class_member_function_names(0),
+ class_member_function_membernames(0),
+ class_member_function_wrappernames(0),
ClassMemberTable(0),
ClassMethodsTable(0),
SClassDefs(0),
@@ -510,7 +521,7 @@
SwigType *funcparams = SwigType_functionpointer_decompose(rettype);
String *rtype = SwigType_str(rettype, 0);
- // ParmList *parms = Getattr(n, "parms");
+ // ParmList *parms = Getattr(n, "parms");
// memory leak
ParmList *parms = SwigType_function_parms(SwigType_del_pointer(Copy(t)), n);
@@ -755,6 +766,8 @@
Swig_register_filebyname("snamespace", s_namespace);
Printf(s_namespace, "useDynLib(%s)\n", DllName);
}
+ // Register the naming functions
+ Swig_name_register("wrapper", "R_swig_%f");
/* Associate the different streams with names so that they can be used in %insert directives by the
typemap code. */
@@ -888,7 +901,33 @@
}
+List *R::filterMemberList(List *class_member_types,
+ List *class_member_other,
+ String *R_MEMBER, bool equal) {
+ // filters class_member_other based on whether corresponding elements of
+ // class_member_function_types are equal or notequal to R_MEMBER
+ List *CM = NewList();
+ Iterator ftype, other;
+ for (ftype = First(class_member_types), other = First(class_member_other);
+ ftype.item;
+ ftype=Next(ftype), other=Next(other)) {
+ // verbose, clean up later if the overall structure works
+ if (equal) {
+ if (ftype.item == R_MEMBER) {
+ Append(CM, other.item);
+ }
+ } else {
+ if (ftype.item != R_MEMBER) {
+ Append(CM, other.item);
+ }
+ }
+ }
+ return(CM);
+}
+
+# if 0
+// not called
/* -------------------------------------------------------------
* We may need to do more.... so this is left as a
* stub for the moment.
@@ -975,9 +1014,6 @@
isSet = strcmp(ptr, "_set") == 0;
}
- // OutputArrayMethod(className, el, out);
- OutputMemberReferenceMethod(className, isSet, el, out);
-
if(outputNamespaceInfo)
Printf(s_namespace, "\"%s\"%s", className, i < n-1 ? "," : "");
}
@@ -988,6 +1024,8 @@
return n;
}
+// end not used
+#endif
/* --------------------------------------------------------------
* Write the methods for $ or $<- for accessing a member field in an
* struct or union (or class).
@@ -1000,9 +1038,10 @@
* out - the stream where we write the code.
* --------------------------------------------------------------*/
-int R::OutputMemberReferenceMethod(String *className, int isSet,
- List *el, File *out) {
- int numMems = Len(el), j;
+int R::OutputMemberReferenceMethod(String *className, int isSet,
+ List *memberList, List *nameList,
+ List *typeList, File *out) {
+ int numMems = Len(memberList), j;
int varaccessor = 0;
if (numMems == 0)
return SWIG_OK;
@@ -1017,13 +1056,12 @@
Node *itemList = NewHash();
bool has_prev = false;
- for(j = 0; j < numMems; j+=3) {
- String *item = Getitem(el, j);
- String *dup = Getitem(el, j + 1);
- char *ptr = Char(dup);
- ptr = &ptr[Len(dup) - 3];
+ for(j = 0; j < numMems; j++) {
+ String *item = Getitem(memberList, j);
+ String *dup = Getitem(nameList, j);
+ String *setgetmethod = Getitem(typeList, j);
- if (!strcmp(ptr, "get"))
+ if (setgetmethod == R_MEMBER_GET)
varaccessor++;
if (Getattr(itemList, item))
@@ -1053,30 +1091,20 @@
if (!isSet && varaccessor > 0) {
Printf(f->code, "%svaccessors = c(", tab8);
- int first = 1;
- for(j = 0; j < numMems; j+=3) {
- String *item = Getitem(el, j);
- String *dup = Getitem(el, j + 1);
- char *ptr = Char(dup);
- ptr = &ptr[Len(dup) - 3];
+ bool first = true;
+ for(j = 0; j < numMems; j++) {
+ String *item = Getitem(memberList, j);
+ String *setgetmethod = Getitem(typeList, j);
- if (!strcmp(ptr, "get")) {
+ // Check the type here instead of the name
+ if (setgetmethod == R_MEMBER_GET) {
Printf(f->code, "%s'%s'", first ? "" : ", ", item);
- first = 0;
+ first = false;
}
}
Printf(f->code, ");\n");
}
-
- /* Printv(f->code, tab8,
- "idx = pmatch(name, names(accessorFuns))\n",
- tab8,
- "if(is.na(idx)) {\n",
- tab8, tab4,
- "stop(\"No ", (isSet ? "modifiable" : "accessible"), " field named \", name, \" in ", className,
- ": fields are \", paste(names(accessorFuns), sep = \", \")",
- ")", "\n}\n", NIL); */
Printv(f->code, ";", tab8,
"idx = pmatch(name, names(accessorFuns));\n",
tab8,
@@ -1123,6 +1151,8 @@
return SWIG_OK;
}
+#if 0
+// not used
/* -------------------------------------------------------------
* Write the methods for [ or [<- for accessing a member field in an
* struct or union (or class).
@@ -1162,6 +1192,7 @@
return SWIG_OK;
}
+#endif
/* -------------------------------------------------------------
* Called when a enumeration is to be processed.
@@ -1207,7 +1238,6 @@
Printf(enum_def_calls, "defineEnumeration(\"%s\",\n .values=c(%s))\n\n", ename, enum_values);
Delete(enum_values);
Delete(ename);
- //Delete(symname);
}
return SWIG_OK;
}
@@ -1335,31 +1365,21 @@
* --------------------------------------------------------------*/
void R::addAccessor(String *memberName, Wrapper *wrapper, String *name,
- int isSet) {
- if(isSet < 0) {
- int n = Len(name);
- char *ptr = Char(name);
- if (n>4) {
- isSet = Strcmp(NewString(&ptr[n-4]), "_set") == 0;
- }
+ String *methodSetGet) {
+
+ if (!class_member_function_names) {
+ class_member_function_names = NewList();
+ class_member_function_membernames = NewList();
+ class_member_function_wrappernames = NewList();
+ class_member_function_types = NewList();
}
-
- List *l = isSet ? class_member_set_functions : class_member_functions;
-
- if(!l) {
- l = NewList();
- if(isSet)
- class_member_set_functions = l;
- else
- class_member_functions = l;
- }
-
- Append(l, memberName);
- Append(l, name);
-
+ Append(class_member_function_types, methodSetGet);
+ Append(class_member_function_names, name);
+ Append(class_member_function_membernames, memberName);
+
String *tmp = NewString("");
Wrapper_print(wrapper, tmp);
- Append(l, tmp);
+ Append(class_member_function_wrappernames, tmp);
// if we could put the wrapper in directly: Append(l, Copy(sfun));
if (debugMode)
Printf(stdout, "Adding accessor: %s (%s) => %s\n", memberName, name, tmp);
@@ -1390,11 +1410,6 @@
c = Getattr(c,"sym:nextSibling");
continue;
}
- /* if (SmartPointer && Getattr(c,"cplus:staticbase")) {
- c = Getattr(c,"sym:nextSibling");
- continue;
- } */
-
/* Make a list of all the declarations (methods) that are overloaded with
* this one particular method name */
@@ -1815,14 +1830,9 @@
/* Add the name of this member to a list for this class_name.
We will dump all these at the end. */
- int n = Len(iname);
- char *ptr = Char(iname);
- bool isSet(0);
- if (n > 4) isSet = Strcmp(NewString(&ptr[n-4]), "_set") == 0;
+ bool isSet(GetFlag(n, "memberset"));
-
- String *tmp = NewString("");
- Printf(tmp, "%s_%s", class_name, isSet ? "set" : "get");
+ String *tmp = NewString(isSet ? Swig_name_set(NSPACE_TODO, class_name) : Swig_name_get(NSPACE_TODO, class_name));
List *memList = Getattr(ClassMemberTable, tmp);
if(!memList) {
@@ -1839,7 +1849,7 @@
int nargs;
String *wname = Swig_name_wrapper(iname);
- Replace(wname, "_wrap", "R_swig", DOH_REPLACE_FIRST);
+
if(overname)
Append(wname, overname);
Setattr(n,"wrap:name", wname);
@@ -1859,11 +1869,6 @@
if(!isVoidReturnType)
addCopyParam = addCopyParameter(rtype);
-
- // Can we get the nodeType() of the type node! and see if it is a struct.
- // int addCopyParam = SwigType_isclass(rtype);
-
- // if(addCopyParam)
if (debugMode)
Printf(stdout, "Adding a .copy argument to %s for %s = %s\n",
iname, type, addCopyParam ? "yes" : "no");
@@ -2261,7 +2266,13 @@
Would like to be able to do this so that we can potentially insert
*/
if(processing_member_access_function || processing_class_member_function) {
- addAccessor(member_name, sfun, iname);
+ String *method_type = R_MEMBER_NORMAL;
+ if (GetFlag(n, "memberset")) {
+ method_type = R_MEMBER_SET;
+ } else if (GetFlag(n, "memberget")) {
+ method_type = R_MEMBER_GET;
+ }
+ addAccessor(member_name, sfun, iname, method_type);
}
if (Getattr(n, "sym:overloaded") &&
@@ -2456,19 +2467,57 @@
// OutputArrayMethod(name, class_member_functions, sfile);
+#if 0
+ // RJB - this bit will need to change
if (class_member_functions)
OutputMemberReferenceMethod(name, 0, class_member_functions, sfile);
if (class_member_set_functions)
OutputMemberReferenceMethod(name, 1, class_member_set_functions, sfile);
+#else
+ if (class_member_function_types) {
- if(class_member_functions) {
- Delete(class_member_functions);
- class_member_functions = NULL;
- }
- if(class_member_set_functions) {
- Delete(class_member_set_functions);
- class_member_set_functions = NULL;
- }
+ // collect the "set" methods
+ List *class_set_membernames = filterMemberList(class_member_function_types,
+ class_member_function_membernames, R_MEMBER_SET, true);
+ List *class_set_functionnames = filterMemberList(class_member_function_types,
+ class_member_function_names, R_MEMBER_SET, true);
+ // this one isn't used - collecting to keep code simpler
+ List *class_set_functiontypes = filterMemberList(class_member_function_types,
+ class_member_function_types, R_MEMBER_SET, true);
+
+ // collect the others
+ List *class_other_membernames = filterMemberList(class_member_function_types,
+ class_member_function_membernames, R_MEMBER_SET, false);
+ List *class_other_functionnames = filterMemberList(class_member_function_types,
+ class_member_function_names, R_MEMBER_SET, false);
+ List *class_other_functiontypes = filterMemberList(class_member_function_types,
+ class_member_function_types, R_MEMBER_SET, false);
+
+ if (Len(class_other_membernames) > 0) {
+ OutputMemberReferenceMethod(name, 0, class_other_membernames, class_other_functionnames, class_other_functiontypes, sfile);
+ }
+ if (Len(class_set_membernames) > 0) {
+ OutputMemberReferenceMethod(name, 1, class_set_membernames, class_set_functionnames, class_set_functiontypes, sfile);
+ }
+ Delete(class_set_membernames);
+ Delete(class_set_functionnames);
+ Delete(class_set_functiontypes);
+ Delete(class_other_membernames);
+ Delete(class_other_functionnames);
+ Delete(class_other_functiontypes);
+ }
+#endif
+
+ if (class_member_function_types) {
+ Delete(class_member_function_types);
+ class_member_function_types = NULL;
+ Delete(class_member_function_names);
+ class_member_function_names = NULL;
+ Delete(class_member_function_membernames);
+ class_member_function_membernames = NULL;
+ Delete(class_member_function_wrappernames);
+ class_member_function_wrappernames = NULL;
+ }
if (Getattr(n, "has_destructor")) {
Printf(sfile, "setMethod('delete', '_p%s', function(obj) {delete%s(obj)})\n", getRClassName(name), getRClassName(name));
