Chicken test suite now runs with no errors

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

CHANGES.current

@@ -1,5 +1,8 @@
 Version 1.3.32 (in progress)
 ============================
+10/26/2007: wuzzeb
+	    [Chicken] Fix global variables of class member function pointers.
+	    Other minor fixes, so all tests in the chicken test suite now pass
 
 10/25/2007: olly
 	    Fix UTL typecheck macro for a function taking char[] or const

Examples/test-suite/apply_strings.i

@@ -35,9 +35,16 @@
 
 // unsigned char* as strings
 #if !defined(SWIGUTL)
+
+#if !defined(SWIGCHICKEN)
+/* Chicken does not allow unsigned char * in strings */
+
 %apply char [ANY] {TAscii[ANY]}
 %apply char [] {TAscii []}
 %apply char * {TAscii *}
+
+#endif
+
 #else
 #warning "UTL needs fixing for these typemaps"
 #endif

Examples/test-suite/chicken/member_pointer_runme.ss

@@ -0,0 +1,28 @@
+(require 'member_pointer)
+
+(define (check-eq? msg expected actual)
+  (if (not (= expected actual))
+    (error "Error " msg ": expected " expected " got " actual)))
+
+(define area-pt (areapt))
+(define perim-pt (perimeterpt))
+
+(define s (new-Square 10))
+
+(check-eq? "Square area" 100.0 (do-op s area-pt))
+(check-eq? "Square perim" 40.0 (do-op s perim-pt))
+
+(check-eq? "Square area" 100.0 (do-op s (areavar)))
+(check-eq? "Square perim" 40.0 (do-op s (perimetervar)))
+
+;; Set areavar to return value of function
+(areavar perim-pt)
+(check-eq? "Square perim" 40 (do-op s (areavar)))
+
+(check-eq? "Square area" 100.0 (do-op s (AREAPT)))
+(check-eq? "Square perim" 40.0 (do-op s (PERIMPT)))
+
+(define test (NULLPT))
+
+(perimetervar (AREAPT))
+(check-eq? "Square area" 100.0 (do-op s (perimetervar)))

Examples/test-suite/common.mk

@@ -233,7 +233,6 @@ CPP_TEST_CASES += \
 	smart_pointer_const \
 	smart_pointer_const2 \
 	smart_pointer_extend \
-	smart_pointer_inherit \
 	smart_pointer_member \
 	smart_pointer_multi \
 	smart_pointer_multi_typedef \
@@ -360,6 +359,7 @@ CPP_STD_TEST_CASES += \
 	li_std_string \
 	li_std_vector \
 	naturalvar \
+	smart_pointer_inherit \
 	template_typedef_fnc \
 	template_type_namespace \
 	template_opaque

Examples/test-suite/exception_partial_info.i

@@ -29,6 +29,9 @@ class ex2 : public myException
 %}
 
 #if !defined(SWIGUTL)
+
+#if !defined(SWIGCHICKEN)
+
 %inline %{
 class Impl
 {
@@ -37,6 +40,11 @@ class Impl
       void f2() throw (myException) { ex2 e; throw e; }
 };
 %}
+
+#else
+#warning "Chicken needs fixing for partial exception information"
+#endif
+
 #else
 #warning "UTL needs fixing for partial exception information"
 #endif

Lib/chicken/chicken.swg

@@ -275,6 +275,43 @@ SIMPLE_TYPEMAP(double, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEO
   free(temp);
 }
 
+%typemap(varin) SWIGTYPE (CLASS::*) {
+  char err_msg[256];
+
+  if (C_swig_is_pair($input)) {
+    /* try and convert pointer object */
+    void *result;
+    if (!SWIG_ConvertPtr(C_block_item($input,1), &result, $descriptor, 0)) {
+      C_word ptr = C_block_item($input,0);
+      if (C_swig_is_string(ptr)) {
+        SWIG_UnpackData(C_c_string(ptr), (void *) &$1, sizeof($type));
+      } else {
+        snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
+        SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
+      }
+    } else {
+      snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
+      SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
+    }
+  } else {
+    snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
+    SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
+  }
+}
+
+%typemap(varout) SWIGTYPE (CLASS::*) {
+  size_t ptr_size = sizeof($type);
+  C_word *known_space = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(2*ptr_size) + C_SIZEOF_SWIG_POINTER);
+  char *temp = (char *)malloc(2*ptr_size);
+  C_word ptr = SWIG_NewPointerObj((void *) known_space, $descriptor, 0);
+
+  SWIG_PackData(temp, (void *) &$varname, ptr_size);
+  $result = C_pair(&known_space, C_string(&known_space, 2*ptr_size, temp), ptr);
+  free(temp);
+}
+
+  
+
 /* Pass-by-value */
 
 %typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE($&1_ltype argp) {
@@ -499,9 +536,6 @@ $result = C_SCHEME_UNDEFINED;
 %typemap(constcode) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
 "static const void *$result = (void*) $value;"
 
-%typemap(constcode) SWIGTYPE (CLASS::*) 
-"static const void *$result = (void*) &$value;"
-
 /* ------------------------------------------------------------
  * String & length
  * ------------------------------------------------------------ */

Source/Modules/chicken.cxx

@@ -876,18 +876,18 @@ int CHICKEN::constantWrapper(Node *n) {
 
   /* Special hook for member pointer */
   if (SwigType_type(t) == T_MPOINTER) {
-    Printf(f_header, "static %s = %s;\n", SwigType_str(t, wname), rvalue);
+    Printf(f_header, "static %s = %s;\n", SwigType_str(t, source), rvalue);
-    value = wname;
-  }
-  if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
-    Replaceall(tm, "$source", rvalue);
-    Replaceall(tm, "$target", source);
-    Replaceall(tm, "$result", source);
-    Replaceall(tm, "$value", rvalue);
-    Printf(f_header, "%s\n", tm);
   } else {
-    Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
+    if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
-    return SWIG_NOWRAP;
+      Replaceall(tm, "$source", rvalue);
+      Replaceall(tm, "$target", source);
+      Replaceall(tm, "$result", source);
+      Replaceall(tm, "$value", rvalue);
+      Printf(f_header, "%s\n", tm);
+    } else {
+      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
+      return SWIG_NOWRAP;
+    }
   }
 
   f = NewWrapper();