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
This commit is contained in:
John Lenz 2007-10-26 23:08:34 +00:00
commit 4ace915a56
7 changed files with 95 additions and 15 deletions

View file

@ -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

View file

@ -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

View file

@ -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)))

View file

@ -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

View file

@ -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

View file

@ -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
* ------------------------------------------------------------ */

View file

@ -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);
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);
Printf(f_header, "static %s = %s;\n", SwigType_str(t, source), rvalue);
} else {
Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
return SWIG_NOWRAP;
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");
return SWIG_NOWRAP;
}
}
f = NewWrapper();