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 000000000..f6fb4099d --- /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 bb43dad48..2ad377af1 100644 --- a/Source/Modules/r.cxx +++ b/Source/Modules/r.cxx @@ -36,11 +36,6 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) { if(Strncmp(b, "struct ", 7) == 0) Replace(b, "struct ", "", DOH_REPLACE_FIRST); - /* Printf(stdout, " %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 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) { Insert(tmp, 0, retName); return tmp; - /* - if(count) - return(b); - - Delete(b); - return(NewString("")); - */ } /* -------------------------------------------------------------- @@ -285,11 +273,16 @@ protected: 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 @@ protected: 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 @@ protected: 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 @@ R::R() : 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 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { 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 @@ int R::top(Node *n) { 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 @@ int R::DumpCode(Node *n) { } +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 @@ int R::OutputClassMemberTable(Hash *tb, File *out) { 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 @@ int R::OutputClassMemberTable(Hash *tb, File *out) { 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 @@ int R::OutputClassMemberTable(Hash *tb, File *out) { * 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 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, 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 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, 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 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, 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 @@ int R::OutputArrayMethod(String *className, List *el, File *out) { return SWIG_OK; } +#endif /* ------------------------------------------------------------- * Called when a enumeration is to be processed. @@ -1207,7 +1238,6 @@ int R::enumDeclaration(Node *n) { 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 @@ int R::variableWrapper(Node *n) { * --------------------------------------------------------------*/ 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 @@ List * R::Swig_overload_rank(Node *n, 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 @@ int R::functionWrapper(Node *n) { /* 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 R::functionWrapper(Node *n) { 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 @@ int R::functionWrapper(Node *n) { 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 @@ int R::functionWrapper(Node *n) { 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 @@ int R::classDeclaration(Node *n) { // 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));