implement the rank-cast dispatch mechanism, which is now the default behavior in perl

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@8045 626c5289-ae23-0410-ae9c-e8d60b6d4f22

SWIG/Examples/test-suite/overload_simple.i

@@ -106,6 +106,23 @@ static char *bar(void *) {
    return (char *) "bar:void *";
 }
 };
+
+
+char *fint(int) {
+   return (char*) "fint:int";
+}
+
+char *fdouble(double) {
+   return (char*) "fdouble:double";
+}
+
+char *num(int) {
+   return (char*) "num:int";
+}
+char *num(double) {
+   return (char*) "num:double";
+}
+
 %}
 
 %inline %{

SWIG/Examples/test-suite/perl5/overload_simple_runme.pl

@@ -4,122 +4,234 @@ $f = new overload_simple::Foo();
 $b = new overload_simple::Bar();
 $v = overload_simple::malloc_void(32);
 
-if (overload_simple::foo(3) != "foo:int") {
+#
+# 'simple' dispatch (no overload) of int and double arguments
+#
+
+#
+# Silence warnings about bad types
+#
+BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } }
+#
+#these tests should 'fail'
+#
+eval { overload_simple::fint("l") };
+if (!$@) {
+    die("fint(int)");
+}
+
+eval { overload_simple::fint("3.5") };
+if (!$@) {
+    die("fint(int)");
+}
+
+eval { overload_simple::fdouble("l") };
+if (!$@) {
+    die("fdouble(double)");
+}
+
+eval { overload_simple::fdouble("1.5/2.0") };
+if (!$@) {
+    die("fdouble(double)");
+}
+
+#
+#enable the warnings again
+#
+$DOWARN =1;
+
+if (!(overload_simple::fint(3) eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fint("1") eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fint(3.0) eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fint("3.0") eq "fint:int")) {
+    die("fint(int)");
+}
+
+# old bad case that now works
+$n = 3;
+$n = $n + 1;
+if (!(overload_simple::fint($n) eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fint(4/2) eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fint(4/2.0) eq "fint:int")) {
+    die("fint(int)");
+}
+
+if (!(overload_simple::fdouble(3) eq "fdouble:double")) {
+    die("fdouble(double)");
+}
+
+if (!(overload_simple::fdouble("3") eq "fdouble:double")) {
+    die("fdouble(double)");
+}
+
+if (!(overload_simple::fdouble(3.0) eq "fdouble:double")) {
+    die("fdouble(double)");
+}
+
+if (!(overload_simple::fdouble("3.0") eq "fdouble:double")) {
+    die("fdouble(double)");
+}
+#
+# Overload between int and double
+#
+if (!(overload_simple::num(3) eq "num:int")) {
+    die("num(int)");
+}
+
+if (!(overload_simple::num("3") eq "num:int")) {
+    die("num(int)");
+}
+
+if (!(overload_simple::num(3.0) eq "num:double")) {
+    die("num(double)");
+}
+
+if (!(overload_simple::num("3.0") eq "num:double")) {
+    die("num(double)");
+}
+
+#
+# Overload between int, double, char * and many types.
+#
+if (!(overload_simple::foo(3) eq "foo:int")) {
     die("foo(int)");
 }
 
-if (overload_simple::foo(3.0) != "foo:double") {
+if (!(overload_simple::foo(3.0) eq "foo:double")) {
     die("foo(double)");
 }
 
-if (overload_simple::foo("hello") != "foo:char *") {
+if (!(overload_simple::foo("3") eq "foo:char *")) {
     die("foo(char *)");
 }
 
-if (overload_simple::foo($f) != "foo:Foo *") {
+if (!(overload_simple::foo("3.0") eq "foo:char *")) {
+    die("foo(char *)");
+}
+
+if (!(overload_simple::foo("hello") eq "foo:char *")) {
+    die("foo(char *)");
+}
+
+if (!(overload_simple::foo($f) eq "foo:Foo *")) {
     die("foo(Foo *)");
 }
 
-if (overload_simple::foo($b) != "foo:Bar *") {
+if (!(overload_simple::foo($b) eq "foo:Bar *")) {
     die("foo(Bar *)");
 }
 
-if (overload_simple::foo($v) != "foo:void *") {
+if (!(overload_simple::foo($v) eq "foo:void *")) {
     die("foo(void *)");
 }
 
-if (overload_simple::blah(3) != "blah:double") {
+if (!(overload_simple::blah(3) eq "blah:double")) {
     die("blah(double)");
 }
 
-if (overload_simple::blah("hello") != "blah:char *") {
+if (!(overload_simple::blah("hello") eq "blah:char *")) {
     die("blah(char *)");
 }
 
 $s = new overload_simple::Spam();
 
-if ($s->foo(3) != "foo:int") {
+if (!($s->foo(3) eq "foo:int")) {
     die("Spam::foo(int)");
 }
 
-if ($s->foo(3.0) != "foo:double") {
+if (!($s->foo(3.0) eq "foo:double")) {
     die("Spam::foo(double)");
 }
 
-if ($s->foo("hello") != "foo:char *") {
+if (!($s->foo("hello") eq "foo:char *")) {
     die("Spam::foo(char *)");
 }
 
-if ($s->foo($f) != "foo:Foo *") {
+if (!($s->foo($f) eq "foo:Foo *")) {
     die("Spam::foo(Foo *)");
 }
 
-if ($s->foo($b) != "foo:Bar *") {
+if (!($s->foo($b) eq "foo:Bar *")) {
     die("Spam::foo(Bar *)");
 }
 
-if ($s->foo($v) != "foo:void *") {
+if (!($s->foo($v) eq "foo:void *")) {
     die("Spam::foo(void *)");
 }
 
-if (overload_simple::Spam::bar(3) != "bar:int") {
+if (!(overload_simple::Spam::bar(3) eq "bar:int")) {
     die("Spam::bar(int)");
 }
 
-if (overload_simple::Spam::bar(3.0) != "bar:double") {
+if (!(overload_simple::Spam::bar(3.0) eq "bar:double")) {
     die("Spam::bar(double)");
 }
 
-if (overload_simple::Spam::bar("hello") != "bar:char *") {
+if (!(overload_simple::Spam::bar("hello") eq "bar:char *")) {
     die("Spam::bar(char *)");
 }
 
-if (overload_simple::Spam::bar($f) != "bar:Foo *") {
+if (!(overload_simple::Spam::bar($f) eq "bar:Foo *")) {
     die("Spam::bar(Foo *)");
 }
 
-if (overload_simple::Spam::bar($b) != "bar:Bar *") {
+if (!(overload_simple::Spam::bar($b) eq "bar:Bar *")) {
     die("Spam::bar(Bar *)");
 }
 
-if (overload_simple::Spam::bar($v) != "bar:void *") {
+if (!(overload_simple::Spam::bar($v) eq "bar:void *")) {
     die("Spam::bar(void *)");
 }
 
 # Test constructors
 
 $s = new overload_simple::Spam();
-if ($s->{type} != "none") {
+if (!($s->{type} eq "none")) {
     die("Spam()");
 }
 
 $s = new overload_simple::Spam(3);
-if ($s->{type} != "int") {
+if (!($s->{type} eq "int")) {
     die("Spam(int)");
 }
 
 $s = new overload_simple::Spam(3.0);
-if ($s->{type} != "double") {
+if (!($s->{type} eq "double")) {
     die("Spam(double)");
 }
 
 $s = new overload_simple::Spam("hello");
-if ($s->{type} != "char *") {
+if (!($s->{type} eq "char *")) {
     die("Spam(char *)");
 }
 
 $s = new overload_simple::Spam($f);
-if ($s->{type} != "Foo *") {
+if (!($s->{type} eq "Foo *")) {
     die("Spam(Foo *)");
 }
 
 $s = new overload_simple::Spam($b);
-if ($s->{type} != "Bar *") {
+if (!($s->{type} eq "Bar *")) {
     die("Spam(Bar *)");
 }
 
 $s = new overload_simple::Spam($v);
-if ($s->{type} != "void *") {
+if (!($s->{type} eq "void *")) {
     die("Spam(void *)");
 }
 

SWIG/Lib/perl5/perlprimtypes.swg

@@ -14,13 +14,47 @@ SWIG_From_dec(long)(long value)
 }
 }
 
-%fragment(SWIG_AsVal_frag(long),"header") {
+%fragment(SWIG_AsVal_frag(long),"header",
+	  fragment=SWIG_AsVal_frag(double)) {
 SWIGINTERN int
 SWIG_AsVal_dec(long)(SV *obj, long* val)
 {
   if (SvIOK(obj)) {
     if (val) *val = SvIV(obj);
     return SWIG_OK;
+  } else {
+    int dispatch = 0;
+    const char *nptr = SvPV(obj, PL_na);
+    if (nptr) {
+      char *endptr;
+      long v = strtol(nptr, &endptr,0);
+      if (errno == ERANGE) {
+	errno = 0;
+	return SWIG_OverflowError;
+      } else {
+	if (*endptr == '\0') {
+	  if (val) *val = v;
+	  return SWIG_AddCast(SWIG_OK);
+	}
+      }
+    }
+    if (!dispatch) {
+      double d;
+      int res = SWIG_AsVal(double)(obj,&d);
+      if (SWIG_IsOK(res)) {
+	if (LONG_MIN <= d && d <= LONG_MAX) {
+	  double rd = rint(d);
+	  if (errno) {
+	    errno = 0;
+	  } else {
+	    if (rd == d) {
+	      if (val) *val = (long)(rd);
+	      return SWIG_AddCast(res);
+	    }
+	  }
+	}
+      }
+    }
   }
   return SWIG_TypeError;
 }
@@ -53,7 +87,23 @@ SWIG_AsVal_dec(unsigned long)(SV *obj, unsigned long *val)
     } else {
       return SWIG_OverflowError;
     }
+  } else {
+    const char *nptr = SvPV(obj, PL_na);
+    if (nptr) {
+      char *endptr;
+      unsigned long v = strtoul(nptr, &endptr,0);
+      if (errno == ERANGE) {
+	errno = 0;
+	return SWIG_OverflowError;
+      } else {
+	if (*endptr == '\0') {
+	  if (val) *val = v;
+	  return SWIG_AddCast(SWIG_OK);
+	}
+      }
+    }
   }
+
   return SWIG_TypeError;
 }
 }
@@ -96,7 +146,7 @@ SWIG_AsVal_dec(long long)(SV *obj, long long *val)
       } else {
 	if (*endptr == '\0') {
 	  if (val) *val = v;
-	  return SWIG_OK;
+	  return SWIG_AddCast(SWIG_OK);
 	}
       }
     }
@@ -143,12 +193,12 @@ SWIG_AsVal_dec(unsigned long long)(SV *obj, unsigned long long *val)
       } else {
 	if (*endptr == '\0') {
 	  if (val) *val = v;
-	  return SWIG_OK;
+	  return SWIG_AddCast(SWIG_OK);
 	}
       }
     }
   }
-  return SWIG_TypeError; 
+  return SWIG_TypeError;
 }
 }
 
@@ -171,8 +221,25 @@ SWIG_AsVal_dec(double)(SV *obj, double *val)
   if (SvNIOK(obj)) {
     if (val) *val = SvNV(obj);
     return SWIG_OK;
-  } 
+  } else if (SvIOK(obj)) {
-
+    if (val) *val = SvIV(obj);
+    return SWIG_AddCast(SWIG_OK);
+  } else {
+    const char *nptr = SvPV(obj, PL_na);
+    if (nptr) {
+      char *endptr;
+      double v = strtod(nptr, &endptr);
+      if (errno == ERANGE) {
+	errno = 0;
+	return SWIG_OverflowError;
+      } else {
+	if (*endptr == '\0') {
+	  if (val) *val = v;
+	  return SWIG_AddCast(SWIG_OK);
+	}
+      }
+    }
+  }
   return SWIG_TypeError;
 }
 }

SWIG/Source/Modules/perl5.cxx

@@ -747,7 +747,7 @@ public:
     } else if (!Getattr(n,"sym:nextSibling")) {
       /* Generate overloaded dispatch function */
       int maxargs, ii;
-      String *dispatch = Swig_overload_dispatch(n,"(*PL_markstack_ptr++);SWIG_CALLXS(%s); return;",&maxargs);
+      String *dispatch = Swig_overload_dispatch_cast(n,"(*PL_markstack_ptr++);SWIG_CALLXS(%s); return;",&maxargs);
 	
       /* Generate a dispatch wrapper for all overloaded functions */