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.

4 files changed, 96 insertions, 16 deletions

diff --git a/CHANGES.current b/CHANGES.current
index 4e374adf5..83a1e20a9 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -25,3 +25,28 @@ Version 4.1.1 (in progress)
 2022-10-27: wsfulton
             [R] Allow NULL to be used in overloaded functions taking shared_ptr.
             Also fixes special variable $argtype expansion in rtypecheck typemaps.
+
+2022-10-28: wsfulton
+            [R] 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.
diff --git a/Lib/r/rtype.swg b/Lib/r/rtype.swg
index a9c067589..c9d68bec8 100644
--- a/Lib/r/rtype.swg
+++ b/Lib/r/rtype.swg
@@ -3,6 +3,7 @@
    for use in class representations. 
  */
 
+%typemap("rtype") bool, bool * "logical"
 %typemap("rtype") int, int *, int & "integer"
 %typemap("rtype") long, long *, long & "integer"
 %typemap("rtype") float, float*, float & "numeric"
@@ -11,7 +12,6 @@
 %typemap("rtype") char "character"
 %typemap("rtype") string, string *, string & "character"
 %typemap("rtype") std::string, std::string *, std::string & "character"
-%typemap("rtype") bool, bool * "logical"
 %typemap("rtype") enum SWIGTYPE "character"
 %typemap("rtype") enum SWIGTYPE * "character"
 %typemap("rtype") enum SWIGTYPE *const& "character"
@@ -30,8 +30,7 @@
 %typemap("rtypecheck") int *, long *
   %{ is.integer($arg) || is.numeric($arg) %}
 
-
-%typemap("rtypecheck") float, double
+%typemap("rtypecheck") float, float &, double, double &
   %{ is.numeric($arg) && length($arg) == 1 %}
 %typemap("rtypecheck") float *, double *
   %{ is.numeric($arg) %}
@@ -41,6 +40,41 @@
 %typemap("rtypecheck") bool *
   %{ is.logical($arg) %}
 
+%typemap("rtypecheck") char
+  %{ is.character($arg) && length($arg) == 1 %}
+%typemap("rtypecheck") char *, char **
+  %{ is.character($arg) %}
+
+%typemap("rtypecheck") string, string &
+  %{ is.character($arg) && length($arg) == 1 %}
+%typemap("rtypecheck") string *
+  %{ is.character($arg) %}
+
+%typemap("rtypecheck") std::string, std::string &
+  %{ is.character($arg) && length($arg) == 1 %}
+%typemap("rtypecheck") std::string *
+  %{ is.character($arg) %}
+
+%typemap("rtypecheck") enum SWIGTYPE, enum SWIGTYPE *const&, enum SWIGTYPE &, const enum SWIGTYPE &, enum SWIGTYPE &&
+  %{ is.character($arg) && length($arg) == 1 %}
+%typemap("rtypecheck") enum SWIGTYPE *
+  %{ is.character($arg) %}
+
+#if 0
+// Replacement rtypecheck typemaps (for swig-4.2, see r.cxx)
+%typemap("rtypecheck") SWIGTYPE *
+  %{ extends($argtype, '$R_class') || is.null($arg) %}
+
+%typemap("rtypecheck") SWIGTYPE &, SWIGTYPE &&
+  %{ extends($argtype, '$R_class') && length($arg) == 1 %}
+
+%typemap("rtypecheck") SWIGTYPE *const&
+  %{ extends($argtype, '$*R_class') && length($arg) == 1 %}
+
+%typemap("rtypecheck") SWIGTYPE
+  %{ extends($argtype, '$&R_class') && length($arg) == 1 %}
+#endif
+
 /*
   Set up type checks to insure overloading precedence.
   We would like non pointer items to shadow pointer items, so that 
diff --git a/Source/Include/swigwarn.h b/Source/Include/swigwarn.h
index fc379c014..f38607f92 100644
--- a/Source/Include/swigwarn.h
+++ b/Source/Include/swigwarn.h
@@ -257,7 +257,11 @@
 
 #define WARN_PYTHON_INDENT_MISMATCH           740
 
-/* please leave 740-759 free for Python */
+/* please leave 740-749 free for Python */
+
+#define WARN_R_MISSING_RTYPECHECK_TYPEMAP     750
+
+/* please leave 750-759 free for R */
 
 #define WARN_RUBY_WRONG_NAME                  801
 #define WARN_RUBY_MULTIPLE_INHERITANCE        802
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");
       }