Merge branch 'r_fixes_2' of https://github.com/fschlimb/swig

Source/Modules/r.cxx

@@ -12,6 +12,7 @@
  * ----------------------------------------------------------------------------- */
 
 #include "swigmod.h"
+#include "cparse.h"
 
 static const double DEFAULT_NUMBER = .0000123456712312312323;
 
@@ -57,11 +58,11 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) {
   return tmp;
 
   /*
-  if(count)
+    if(count)
     return(b);
 
-  Delete(b);
+    Delete(b);
-  return(NewString(""));
+    return(NewString(""));
   */
 }
 
@@ -90,7 +91,7 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
 #ifdef R_SWIG_VERBOSE
     if (debugMode)
       Printf(stdout, "SwigType_split return an empty list for %s\n",
-	     retType);
+             retType);
 #endif
     return(tmp);
   }
@@ -106,8 +107,8 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
   if(addRef) {
     for(int i = 0; i < n; i++) {
       if(Strcmp(Getitem(l, i), "p.") == 0 ||
-	 Strncmp(Getitem(l, i), "a(", 2) == 0)
+         Strncmp(Getitem(l, i), "a(", 2) == 0)
-	Printf(tmp, "Ref");
+        Printf(tmp, "Ref");
     }
   }
 
@@ -211,14 +212,14 @@ R Options (available with -r)\n\
      -cppcast         - Enable C++ casting operators (default) \n\
      -debug           - Output debug\n\
      -dll <name>      - Name of the DLL (without the .dll or .so suffix).\n\
-                        Default is the module name.\n\
+	                Default is the module name.\n\
      -gc              - Aggressive garbage collection\n\
      -memoryprof      - Add memory profile\n\
      -namespace       - Output NAMESPACE file\n\
      -no-init-code    - Turn off the generation of the R_init_<pkgname> code\n\
-                        (registration information still generated)\n\
+	                (registration information still generated)\n\
      -package <name>  - Package name for the PACKAGE argument of the R .Call()\n\
-                        invocations. Default is the module name.\n\
+	                invocations. Default is the module name.\n\
 ";
 
 
@@ -291,6 +292,9 @@ public:
 
   int typedefHandler(Node *n);
 
+  static List *Swig_overload_rank(Node *n,
+	                          bool script_lang_wrapping);
+
   int memberfunctionHandler(Node *n) {
     if (debugMode)
       Printf(stdout, "<memberfunctionHandler> %s %s\n",
@@ -531,7 +535,7 @@ void R::addSMethodInfo(String *name, String *argType, int nargs) {
 }
 
 /*
-Returns the name of the new routine.
+  Returns the name of the new routine.
 */
 String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
   String *funName = SwigType_manglestr(t);
@@ -587,7 +591,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
 
   emit_parameter_variables(parms, f);
   emit_return_variable(n, rettype, f);
-//  emit_attach_parmmaps(parms,f);
+  //  emit_attach_parmmaps(parms,f);
 
   /*  Using weird name and struct to avoid potential conflicts. */
   Wrapper_add_local(f, "r_swig_cb_data", "RCallbackFunctionData *r_swig_cb_data = R_SWIG_getCallbackFunctionData()");
@@ -906,7 +910,7 @@ int R::DumpCode(Node *n) {
     writeListByLine(namespaceFunctions, ns);
     Printf(ns, ")\n");
     Printf(ns, "\nexportMethods(\n");
-    writeListByLine(namespaceFunctions, ns, 1);
+    writeListByLine(namespaceMethods, ns, 1);
     Printf(ns, ")\n");
     Delete(ns);
     Delete(s_namespace);
@@ -984,6 +988,7 @@ int R::OutputClassMemberTable(Hash *tb, File *out) {
   /* This function checks for names ending in _set - perhaps it should */
   /* use attributes of some other form, as it potentially clashes with */
   /* methods ending in _set */
+
   if(n && outputNamespaceInfo) {
     Printf(s_namespace, "exportClasses(");
   }
@@ -1018,7 +1023,7 @@ int R::OutputClassMemberTable(Hash *tb, File *out) {
  struct or union (or class).
  className - the name of the struct or union (e.g. Bar for struct Bar)
  isSet - a logical value indicating whether the method is for
-           modifying ($<-) or accessing ($) the member field.
+	   modifying ($<-) or accessing ($) the member field.
  el - a list of length  2 * # accessible member elements  + 1.
       The first element is the name of the class.
       The other pairs are  member name and the name of the R function to access it.
@@ -1043,10 +1048,6 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
   bool has_prev = false;
   for(j = 0; j < numMems; j+=3) {
     String *item = Getitem(el, j);
-    if (Getattr(itemList, item)) 
-      continue;
-    Setattr(itemList, item, "1");
-    
     String *dup = Getitem(el, j + 1);
     char *ptr = Char(dup);
     ptr = &ptr[Len(dup) - 3];
@@ -1054,6 +1055,10 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
     if (!strcmp(ptr, "get"))
       varaccessor++;
 
+    if (Getattr(itemList, item))
+      continue;
+    Setattr(itemList, item, "1");
+
     String *pitem;
     if (!Strcmp(item, "operator ()")) {
       pitem = NewString("call");
@@ -1312,6 +1317,260 @@ void R::addAccessor(String *memberName, Wrapper *wrapper, String *name,
     Printf(stdout, "Adding accessor: %s (%s) => %s\n", memberName, name, tmp);
 }
 
+#define MAX_OVERLOAD 256
+
+struct Overloaded {
+  Node      *n;          /* Node                               */
+  int        argc;       /* Argument count                     */
+  ParmList  *parms;      /* Parameters used for overload check */
+  int        error;      /* Ambiguity error                    */
+};
+
+
+List * R::Swig_overload_rank(Node *n,
+	                     bool script_lang_wrapping) {
+  Overloaded  nodes[MAX_OVERLOAD];
+  int         nnodes = 0;
+  Node *o = Getattr(n,"sym:overloaded");
+
+
+  if (!o) return 0;
+
+  Node *c = o;
+  while (c) {
+    if (Getattr(c,"error")) {
+      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 */
+
+    if (Getattr(c,"wrap:name")) {
+      nodes[nnodes].n = c;
+      nodes[nnodes].parms = Getattr(c,"wrap:parms");
+      nodes[nnodes].argc = emit_num_required(nodes[nnodes].parms);
+      nodes[nnodes].error = 0;
+      nnodes++;
+    }
+    c = Getattr(c,"sym:nextSibling");
+  }
+
+  /* Sort the declarations by required argument count */
+  {
+    int i,j;
+    for (i = 0; i < nnodes; i++) {
+      for (j = i+1; j < nnodes; j++) {
+	if (nodes[i].argc > nodes[j].argc) {
+	  Overloaded t = nodes[i];
+	  nodes[i] = nodes[j];
+	  nodes[j] = t;
+	}
+      }
+    }
+  }
+
+  /* Sort the declarations by argument types */
+  {
+    int i,j;
+    for (i = 0; i < nnodes-1; i++) {
+      if (nodes[i].argc == nodes[i+1].argc) {
+	for (j = i+1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) {
+	  Parm *p1 = nodes[i].parms;
+	  Parm *p2 = nodes[j].parms;
+	  int   differ = 0;
+	  int   num_checked = 0;
+	  while (p1 && p2 && (num_checked < nodes[i].argc)) {
+	    if (debugMode) {
+	      Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type"));
+	    }
+	    if (checkAttribute(p1,"tmap:in:numinputs","0")) {
+	      p1 = Getattr(p1,"tmap:in:next");
+	      continue;
+	    }
+	    if (checkAttribute(p2,"tmap:in:numinputs","0")) {
+	      p2 = Getattr(p2,"tmap:in:next");
+	      continue;
+	    }
+	    String *t1 = Getattr(p1,"tmap:typecheck:precedence");
+	    String *t2 = Getattr(p2,"tmap:typecheck:precedence");
+	    if (debugMode) {
+	      Printf(stdout,"t1 = '%s', t2 = '%s'\n", t1, t2);
+	    }
+	    if ((!t1) && (!nodes[i].error)) {
+	      Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n),
+			   "Overloaded method %s not supported (incomplete type checking rule - no precedence level in typecheck typemap for '%s').\n",
+			   Swig_name_decl(nodes[i].n), SwigType_str(Getattr(p1, "type"), 0));
+	      nodes[i].error = 1;
+	    } else if ((!t2) && (!nodes[j].error)) {
+	      Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n),
+			   "Overloaded method %s not supported (incomplete type checking rule - no precedence level in typecheck typemap for '%s').\n",
+			   Swig_name_decl(nodes[j].n), SwigType_str(Getattr(p2, "type"), 0));
+	      nodes[j].error = 1;
+	    }
+	    if (t1 && t2) {
+	      int t1v, t2v;
+	      t1v = atoi(Char(t1));
+	      t2v = atoi(Char(t2));
+	      differ = t1v-t2v;
+	    }
+	    else if (!t1 && t2) differ = 1;
+	    else if (t1 && !t2) differ = -1;
+	    else if (!t1 && !t2) differ = -1;
+	    num_checked++;
+	    if (differ > 0) {
+	      Overloaded t = nodes[i];
+	      nodes[i] = nodes[j];
+	      nodes[j] = t;
+	      break;
+	    } else if ((differ == 0) && (Strcmp(t1,"0") == 0)) {
+	      t1 = Getattr(p1,"ltype");
+	      if (!t1) {
+		t1 = SwigType_ltype(Getattr(p1,"type"));
+		if (Getattr(p1,"tmap:typecheck:SWIGTYPE")) {
+		  SwigType_add_pointer(t1);
+		}
+		Setattr(p1,"ltype",t1);
+	      }
+	      t2 = Getattr(p2,"ltype");
+	      if (!t2) {
+		t2 = SwigType_ltype(Getattr(p2,"type"));
+		if (Getattr(p2,"tmap:typecheck:SWIGTYPE")) {
+		  SwigType_add_pointer(t2);
+		}
+		Setattr(p2,"ltype",t2);
+	      }
+
+	      /* Need subtype check here.  If t2 is a subtype of t1, then we need to change the
+	         order */
+
+	      if (SwigType_issubtype(t2,t1)) {
+		Overloaded t = nodes[i];
+		nodes[i] = nodes[j];
+		nodes[j] = t;
+	      }
+
+	      if (Strcmp(t1,t2) != 0) {
+		differ = 1;
+		break;
+	      }
+	    } else if (differ) {
+	      break;
+	    }
+	    if (Getattr(p1,"tmap:in:next")) {
+	      p1 = Getattr(p1,"tmap:in:next");
+	    } else {
+	      p1 = nextSibling(p1);
+	    }
+	    if (Getattr(p2,"tmap:in:next")) {
+	      p2 = Getattr(p2,"tmap:in:next");
+	    } else {
+	      p2 = nextSibling(p2);
+	    }
+	  }
+	  if (!differ) {
+	    /* See if declarations differ by const only */
+	    String *d1 = Getattr(nodes[i].n, "decl");
+	    String *d2 = Getattr(nodes[j].n, "decl");
+	    if (d1 && d2) {
+	      String *dq1 = Copy(d1);
+	      String *dq2 = Copy(d2);
+	      if (SwigType_isconst(d1)) {
+		Delete(SwigType_pop(dq1));
+	      }
+	      if (SwigType_isconst(d2)) {
+		Delete(SwigType_pop(dq2));
+	      }
+	      if (Strcmp(dq1, dq2) == 0) {
+
+		if (SwigType_isconst(d1) && !SwigType_isconst(d2)) {
+		  if (script_lang_wrapping) {
+		    // Swap nodes so that the const method gets ignored (shadowed by the non-const method)
+		    Overloaded t = nodes[i];
+		    nodes[i] = nodes[j];
+		    nodes[j] = t;
+		  }
+		  differ = 1;
+		  if (!nodes[j].error) {
+		    if (script_lang_wrapping) {
+		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
+				   "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
+		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n),
+				   "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n));
+		    } else {
+		      if (!Getattr(nodes[j].n, "overload:ignore")) {
+			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
+				     "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
+			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
+				     "using %s instead.\n", Swig_name_decl(nodes[i].n));
+		      }
+		    }
+		  }
+		  nodes[j].error = 1;
+		} else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) {
+		  differ = 1;
+		  if (!nodes[j].error) {
+		    if (script_lang_wrapping) {
+		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n),
+				   "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
+		      Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n),
+				   "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n));
+		    } else {
+		      if (!Getattr(nodes[j].n, "overload:ignore")) {
+			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
+				     "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
+			Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
+				     "using %s instead.\n", Swig_name_decl(nodes[i].n));
+		      }
+		    }
+		  }
+		  nodes[j].error = 1;
+		}
+	      }
+	      Delete(dq1);
+	      Delete(dq2);
+	    }
+	  }
+	  if (!differ) {
+	    if (!nodes[j].error) {
+	      if (script_lang_wrapping) {
+		Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n),
+			     "Overloaded method %s effectively ignored,\n", Swig_name_decl(nodes[j].n));
+		Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[i].n), Getline(nodes[i].n),
+			     "as it is shadowed by %s.\n", Swig_name_decl(nodes[i].n));
+	      } else {
+		if (!Getattr(nodes[j].n, "overload:ignore")) {
+		  Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n),
+			       "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n));
+		  Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n),
+			       "using %s instead.\n", Swig_name_decl(nodes[i].n));
+		}
+	      }
+	      nodes[j].error = 1;
+	    }
+	  }
+	}
+      }
+    }
+  }
+  List *result = NewList();
+  {
+    int i;
+    for (i = 0; i < nnodes; i++) {
+      if (nodes[i].error)
+	Setattr(nodes[i].n, "overload:ignore", "1");
+      Append(result,nodes[i].n);
+      //      Printf(stdout,"[ %d ] %s\n", i, ParmList_errorstr(nodes[i].parms));
+      //      Swig_print_node(nodes[i].n);
+    }
+  }
+  return result;
+}
+
 void R::dispatchFunction(Node *n) {
   Wrapper *f = NewWrapper();
   String *symname = Getattr(n, "sym:name");
@@ -1392,29 +1651,29 @@ void R::dispatchFunction(Node *n) {
 	if (tm) {
 	  if (Strcmp(tm,"numeric")==0) {
 	    Printf(f->code, "%sis.numeric(argv[[%d]])",
-		j == 0 ? "" : " && ",
+	           j == 0 ? "" : " && ",
-		j+1);
+	           j+1);
 	  }
 	  else if (Strcmp(tm,"integer")==0) {
 	    Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))",
-		j == 0 ? "" : " && ",
+	           j == 0 ? "" : " && ",
-		j+1, j+1);
+	           j+1, j+1);
 	  }
 	  else if (Strcmp(tm,"character")==0) {
 	    Printf(f->code, "%sis.character(argv[[%d]])",
-		j == 0 ? "" : " && ",
+	           j == 0 ? "" : " && ",
-		j+1);
+	           j+1);
 	  }
 	  else {
 	    Printf(f->code, "%sextends(argtypes[%d], '%s')",
-		j == 0 ? "" : " && ",
+	           j == 0 ? "" : " && ",
-		j+1,
+	           j+1,
-		tm);
+	           tm);
 	  }
 	}
 	if (!SwigType_ispointer(Getattr(p, "type"))) {
 	  Printf(f->code, " && length(argv[[%d]]) == 1",
-	      j+1);
+	         j+1);
 	}
 	p = Getattr(p, "tmap:in:next");
       }
@@ -1570,8 +1829,16 @@ int R::functionWrapper(Node *n) {
   Printf(sfun->def, "# Start of %s\n", iname);
   Printv(sfun->def, "\n`", sfname, "` = function(", NIL);
 
-  if(outputNamespaceInfo) //XXX Need to be a little more discriminating
+  if(outputNamespaceInfo) {//XXX Need to be a little more discriminating
-    addNamespaceFunction(iname);
+    if (constructor) {
+      String *niname = Copy(iname);
+      Replace(niname, "new_", "", DOH_REPLACE_FIRST);
+      addNamespaceFunction(niname);
+      Delete(niname);
+    } else {
+      addNamespaceFunction(iname);
+    }
+  }
 
   Swig_typemap_attach_parms("scoercein", l, f);
   Swig_typemap_attach_parms("scoerceout", l, f);
@@ -1872,6 +2139,15 @@ int R::functionWrapper(Node *n) {
   if ((tm = Swig_typemap_lookup("scoerceout", n, Swig_cresult_name(), sfun))) {
     Replaceall(tm,"$source","ans");
     Replaceall(tm,"$result","ans");
+    if (constructor) {
+      Node * parent = Getattr(n, "parentNode");
+      String * smartname = Getattr(parent, "feature:smartptr");
+      if (smartname) {
+	smartname = getRClassName(smartname, 1, 1);
+	Replaceall(tm, "$R_class", smartname);
+	Delete(smartname);
+      }
+    }
     replaceRClass(tm, Getattr(n, "type"));
     Chop(tm);
   }
@@ -2014,7 +2290,13 @@ int R::outputRegistrationRoutines(File *out) {
   if(!noInitializationCode) {
     if (inCPlusMode)
       Printv(out, "extern \"C\" ", NIL);
-    Printf(out, "SWIGEXPORT void R_init_%s(DllInfo *dll) {\n", Rpackage);
+    { /* R allows pckage names to have '.' in the name, which is not allowed in C++ var names
+	 we simply replace all occurrences of '.' with '_' to construct the var name */
+      String * Rpackage_sane = Copy(Rpackage);
+      Replace(Rpackage_sane, ".", "_", DOH_REPLACE_ANY);
+      Printf(out, "SWIGEXPORT void R_init_%s(DllInfo *dll) {\n", Rpackage_sane);
+      Delete(Rpackage_sane);
+    }
     Printf(out, "%sR_registerRoutines(dll, NULL, CallEntries, NULL, NULL);\n", tab4);
     if(Len(s_init_routine)) {
       Printf(out, "\n%s\n", s_init_routine);
@@ -2066,8 +2348,32 @@ void R::registerClass(Node *n) {
 
     Printf(s_classes, "setClass('%s', contains = %s)\n", sname, base);
     Delete(base);
+    String *smartptr = Getattr(n, "feature:smartptr");
+    if (smartptr) {
+      List *l = Getattr(n, "bases");
+      SwigType *spt = Swig_cparse_type(smartptr);
+      String *smart = SwigType_typedef_resolve_all(spt);
+      String *smart_rname = SwigType_manglestr(smart);
+      Printf(s_classes, "setClass('_p%s', contains = c('%s'", smart_rname, sname);
+      Delete(spt);
+      Delete(smart);
+      Delete(smart_rname);
+      for(int i = 0; i < Len(l); i++) {
+	Node * b = Getitem(l, i);
+	smartptr = Getattr(b, "feature:smartptr");
+	if (smartptr) {
+	  spt = Swig_cparse_type(smartptr);
+	  smart = SwigType_typedef_resolve_all(spt);
+	  smart_rname = SwigType_manglestr(smart);
+	  Printf(s_classes, ", '_p%s'", smart_rname);
+	  Delete(spt);
+	  Delete(smart);
+	  Delete(smart_rname);
+	}
+      }
+      Printf(s_classes, "))\n");
+    }
   }
-  
 }
 
 int R::classDeclaration(Node *n) {
@@ -2537,17 +2843,4 @@ String * R::processType(SwigType *t, Node *n, int *nargs) {
     return NULL;
 }
 
-
-
-
-
-
-
-
-
 /*************************************************************************************/
-
-
-
-
-