R rtypecheck typemaps

Further switch to use rtypecheck typemaps instead of hard coded logic.
The full switch to typemaps is deferred until swig-4.2 as it can't be fully
backwards compatible. For now a warning is provided to help the
transition. It provides the full typemap that should be placed into
a user's interface file, for example:

%typemap("rtype") int32_t * "integer"
void testmethod(int32_t * i);
void testmethod();

If there is no rtypecheck typemap for int32_t *, the warning shown is:

example.i:7: Warning 750: Optional rtypecheck code is deprecated. Add the
following typemap to fix as the next version of SWIG will not work without it:
%typemap("rtypecheck") int32_t * %{ (is.integer($arg) || is.numeric($arg)) %}

The warning is shown for any code that previously used "numeric", "integer" or
"character" for the rtype typemap. Copying the rtypecheck typemap as
shown into the user interface file will provide the appropriate fix and
the warning will disappear. This is important to do as swig-4.2 will
not be able to provide this helpful warning.

1 files changed, 29 insertions, 12 deletions

diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx
index c8b34cb54..9b465a571 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -1600,7 +1600,7 @@ void R::dispatchFunction(Node *n) {
 	  Swig_print_node(p);
 	}
 	String *tm = Swig_typemap_lookup("rtype", p, "", 0);
-	if(tm) {
+	if (tm) {
 	  replaceRClass(tm, Getattr(p, "type"));
 	}
 
@@ -1610,9 +1610,7 @@ void R::dispatchFunction(Node *n) {
 	  Replaceall(tmcheck, "$argtype", tmp_argtype);
 	  String *tmp_arg = NewStringf("argv[[%d]]", j+1);
 	  Replaceall(tmcheck, "$arg", tmp_arg);
-	  if (tm) {
-	    Replaceall(tmcheck, "$rtype", tm);
-	  }
+	  replaceRClass(tmcheck, Getattr(p, "type"));
 	  if (debugMode) {
 	    Printf(stdout, "<rtypecheck>%s\n", tmcheck);
 	  }
@@ -1627,23 +1625,42 @@ void R::dispatchFunction(Node *n) {
 	  continue;
 	}
 	// Below should be migrated into rtypecheck typemaps
+	// Preparation for this has started by warning in swig-4.1.1 for "numeric", "integer", "character" typemaps
+	// For swig-4.2: remove the code block below and uncomment typemaps marked 'Replacement rtypecheck typemaps' in rtype.swg.
+	// There is a slight difference in output as the typemap approach fixes some bugs due to a missing type resolution below
 	if (tm) {
+	  String *tmcode = NULL;
 	  Printf(f->code, "%s", j == 0 ? "" : " && ");
+	  if (num_arguments != 1)
+	    Printf(f->code, "(");
+	  Printf(f->code, " ");
 	  if (Strcmp(tm, "numeric") == 0) {
-	    Printf(f->code, "is.numeric(argv[[%d]])", j+1);
+	    tmcode = NewString("is.numeric($arg)");
 	  } else if (Strcmp(tm, "integer") == 0) {
-	    Printf(f->code, "(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", j+1, j+1);
+	    tmcode = NewString("(is.integer($arg) || is.numeric($arg))");
 	  } else if (Strcmp(tm, "character") == 0) {
-	    Printf(f->code, "is.character(argv[[%d]])", j+1);
+	    tmcode = NewString("is.character($arg)");
 	  } else {
 	    if (SwigType_ispointer(Getattr(p, "type")))
-	      Printf(f->code, "(extends(argtypes[%d], '%s') || is.null(argv[[%d]]))", j+1, tm, j+1);
+	      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);
+	      Printf(f->code, "extends(argtypes[%d], '%s') && length(argv[[%d]]) == 1", j+1, tm, j+1);
 	  }
-	}
-	if (!SwigType_ispointer(Getattr(p, "type"))) {
-	  Printf(f->code, " && length(argv[[%d]]) == 1", j+1);
+	  if (tmcode) {
+	    if (!SwigType_ispointer(Getattr(p, "type")))
+	      Printf(tmcode, " && length($arg) == 1");
+	    Swig_warning(WARN_R_MISSING_RTYPECHECK_TYPEMAP, input_file, line_number,
+			 "Optional rtypecheck code is deprecated. Add the following typemap to fix as the next version of SWIG will not work without it: %%typemap(\"rtypecheck\") %s %%{ %s %%}\n",
+			 SwigType_str(Getattr(p, "type"), 0), tmcode);
+	    String *tmp_arg = NewStringf("argv[[%d]]", j+1);
+	    Replaceall(tmcode, "$arg", tmp_arg);
+	    Printv(f->code, tmcode, NIL);
+	    Delete(tmp_arg);
+	  }
+	  Printf(f->code, " ");
+	  if (num_arguments != 1)
+	    Printf(f->code, ")");
+	  Delete(tmcode);
 	}
 	p = Getattr(p, "tmap:in:next");
       }