jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

The guile and chicken _runme scripts are now shared

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@5979 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
John Lenz 2004-06-07 05:03:39 +00:00
commit 60f4c8988e
74 changed files with 505 additions and 490 deletions
Download patch file Download diff file Expand all files Collapse all files

7
CHANGES.current
View file

@ -1,6 +1,13 @@
Version 1.3.22 (in progress)
==================================
06/06/2004: wuzzeb (John Lenz)
[Chicken, Guile]
- Created the Examples/test-suite/schemerunme directory, which holds all the
runme scripts for guile and chicken (and possibly mzscheme...). The guile
and chicken _runme files then (load "../schemerunme/foo.scm").
- In chicken module, fix a few bugs invlolving dynamic casts.
06/03/2004: wsfulton
Patch to fix wrapping of templated methods. ISO compliant compilers, like
Comeau and GCC-3.4.0, don't like the template specifier that SWIG was generating

8
Examples/Makefile.in
View file

@ -941,7 +941,7 @@ chicken: $(SRCS)
-dynamic -feature chicken-compile-shared \
-output-file $(CHICKEN_COMPILED_SCHEME)
$(CC) -c $(CCSHARED) $(CFLAGS) $(CHICKEN_CFLAGS) \
$(INCLUDE) $(CHICKEN_INCLUDE) $(ISRCS) $(SRCS) $(CHICKEN_COMPILED_SCHEME)
$(INCLUDES) $(CHICKEN_INCLUDE) $(ISRCS) $(SRCS) $(CHICKEN_COMPILED_SCHEME)
$(LDSHARED) $(CHICKEN_COMPILED_OBJECT) $(OBJS) $(IOBJS) \
$(LIBS) $(CHICKEN_SHAREDLIBOPTS) -o $(TARGET)$(SO)
@ -951,7 +951,7 @@ chicken_cpp: $(CXXSRCS) $(CHICKSRCS)
-dynamic -feature chicken-compile-shared \
-output-file $(CHICKEN_COMPILED_SCHEME)
$(CXX) -c $(CCSHARED) $(CFLAGS) $(CHICKEN_CFLAGS) \
$(INCLUDE) $(CHICKEN_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) $(CHICKEN_COMPILED_SCHEME)
$(INCLUDES) $(CHICKEN_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) $(CHICKEN_COMPILED_SCHEME)
$(CXXSHARED) $(CHICKEN_COMPILED_OBJECT) $(OBJS) $(IOBJS) \
$(LIBS) $(CPP_DLLIBS) $(CHICKEN_SHAREDLIBOPTS) -o $(TARGET)$(SO)
@ -967,7 +967,7 @@ chicken_static: $(SRCS) $(CHICKSRCS)
$(CHICKEN) $(CHICKEN_MAIN) $(CHICKENOPTS) \
-output-file $(CHICKEN_MAIN:.scm=_chicken.c)
$(CC) -c $(CCSHARED) $(CFLAGS) $(CHICKEN_CFLAGS) \
$(INCLUDE) $(CHICKEN_INCLUDE) $(ISRCS) $(SRCS) \
$(INCLUDES) $(CHICKEN_INCLUDE) $(ISRCS) $(SRCS) \
$(CHICKEN_COMPILED_SCHEME) $(CHICKEN_COMPILED_MAIN)
$(CC) $(CHICKEN_COMPILED_OBJECT) $(CHICKEN_COMPILED_MAIN_OBJECT) \
$(OBJS) $(IOBJS) $(LIBS) $(CHICKEN_SHAREDLIBOPTS) -o $(TARGET)
@ -979,7 +979,7 @@ chicken_static_cpp: $(CXXSRCS) $(CHICKSRCS)
$(CHICKEN) $(CHICKEN_MAIN) $(CHICKENOPTS) \
-output-file $(CHICKEN_MAIN:.scm=_chicken.c)
$(CXX) -c $(CCSHARED) $(CFLAGS) $(CHICKEN_CFLAGS) \
$(INCLUDE) $(CHICKEN_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) \
$(INCLUDES) $(CHICKEN_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS) \
$(CHICKEN_COMPILED_SCHEME) $(CHICKEN_COMPILED_MAIN)
$(CXX) $(CHICKEN_COMPILED_OBJECT) $(CHICKEN_COMPILED_MAIN_OBJECT) \
$(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) $(CHICKEN_SHAREDLIBOPTS) -o $(TARGET)

3
Examples/test-suite/chicken/Makefile.in
View file

@ -9,7 +9,7 @@ SCRIPTSUFFIX = _runme.ss
srcdir = @srcdir@
top_srcdir = @top_srcdir@
top_builddir = @top_builddir@
CHICKEN_CSI = @CHICKEN_CSI@
CHICKEN_CSI = @CHICKEN_CSI@ -quiet
SO = @SO@
#C_TEST_CASES = long_long list_vector pointer_in_out multivalue
@ -17,6 +17,7 @@ SO = @SO@
include $(srcdir)/../common.mk
# Overridden variables here
SWIGOPT += -noprefix
# none!
# Rules for the different types of tests

1
Examples/test-suite/chicken/casts_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/casts.scm")

1
Examples/test-suite/chicken/char_constant_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/char_constant.scm")

1
Examples/test-suite/chicken/class_ignore_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/class_ignore.scm")

1
Examples/test-suite/chicken/constover_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/constover.scm")

1
Examples/test-suite/chicken/contract_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/contract.scm")

1
Examples/test-suite/chicken/cpp_namespace_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/cpp_namespace.scm")

1
Examples/test-suite/chicken/dynamic_cast_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/dynamic_cast.scm")

1
Examples/test-suite/chicken/import_nomodule_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/import_nomodule.scm")

1
Examples/test-suite/chicken/imports_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/imports.scm")

1
Examples/test-suite/chicken/inherit_missing_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/inherit_missing.scm")

1
Examples/test-suite/chicken/list_vector_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/list_vector.scm")

3
Examples/test-suite/chicken/multivalue_runme.ss Normal file
View file

@ -0,0 +1,3 @@
;; this doesn't work yet :(
;;(include "../schemerunme/multivalue.scm")
(exit 0)

1
Examples/test-suite/chicken/name_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/name.scm")

1
Examples/test-suite/chicken/overload_complicated_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/overload_complicated.scm")

1
Examples/test-suite/chicken/overload_copy_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/overload_copy.scm")

1
Examples/test-suite/chicken/overload_extend_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/overload_extend.scm")

1
Examples/test-suite/chicken/overload_simple_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/overload_simple.scm")

1
Examples/test-suite/chicken/overload_subtype_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/overload_subtype.scm")

1
Examples/test-suite/chicken/pointer_in_out_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/pointer_in_out.scm")

1
Examples/test-suite/chicken/reference_global_vars_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/reference_global_vars.scm")

1
Examples/test-suite/chicken/typedef_inherit_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/typedef_inherit.scm")

1
Examples/test-suite/chicken/typename_runme.ss Normal file
View file

@ -0,0 +1 @@
(include "../schemerunme/typename.scm")

37
Examples/test-suite/chicken/unions_runme.ss
View file

@ -1,36 +1 @@
;;; This is the union runtime testcase. It ensures that values within a
;;; union embedded within a struct can be set and read correctly.
;; Create new instances of SmallStruct and BigStruct for later use
(define small (unions:new-SmallStruct))
(unions:SmallStruct-jill-set small 200)
(define big (unions:new-BigStruct))
(unions:BigStruct-smallstruct-set big small)
(unions:BigStruct-jack-set big 300)
;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
;; Ensure values in EmbeddedUnionTest are set correctly for each.
(define eut (unions:new-EmbeddedUnionTest))
;; First check the SmallStruct in EmbeddedUnionTest
(unions:EmbeddedUnionTest-number-set eut 1)
(unions:EmbeddedUnionTest-uni-small-set (unions:EmbeddedUnionTest-uni-get eut)
small)
(let ((Jill1 (unions:SmallStruct-jill-get
(unions:EmbeddedUnionTest-uni-small-get
(unions:EmbeddedUnionTest-uni-get eut)))))
(if (not (= Jill1 200))
(begin
(display "Runtime test 1 failed.")
(exit 1))))
(let ((Num1 (unions:EmbeddedUnionTest-number-get eut)))
(if (not (= Num1 1))
(begin
(display "Runtime test 2 failed.")
(exit 1))))
;; that should do
(exit 0)
(include "../schemerunme/unions.scm")

10
Examples/test-suite/guile/casts_runme.scm
View file

@ -2,12 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_casts_module" (dynamic-link "./libcasts.so"))
(define x (new-B))
;; This fails in 1.3a5 because the SWIG/Guile runtime code gets the
;; source and the target of a cast the wrong way around.
(A-hello x)
(exit 0)
(load "../schemerunme/casts.scm")

6
Examples/test-suite/guile/char_constant_runme.scm
View file

@ -2,8 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_char_constant_module" (dynamic-link "./libchar_constant.so"))
(if (and (char? (CHAR-CONSTANT))
(string? (STRING-CONSTANT)))
(exit 0)
(exit 1))
(load "../schemerunme/char_constant.scm")

8
Examples/test-suite/guile/class_ignore_runme.scm
View file

@ -1,8 +1,2 @@
(dynamic-call "scm_init_class_ignore_module" (dynamic-link "./libclass_ignore.so"))
(define a (new-Bar))
(if (not (string=? (Bar-blah a) "Bar::blah"))
(error "Wrong string"))
(exit 0)
(load "../schemerunme/class_ignore.scm")

28
Examples/test-suite/guile/constover_runme.scm
View file

@ -1,28 +1,2 @@
(dynamic-call "scm_init_constover_module" (dynamic-link "./libconstover.so"))
(define p (test "test"))
(if (not (string=? p "test"))
(error "test failed!"))
(set! p (test-pconst "test"))
(if (not (string=? p "test_pconst"))
(error "test_pconst failed!"))
(define f (new-Foo))
(set! p (Foo-test f "test"))
(if (not (string=? p "test"))
(error "member-test failed!"))
(set! p (Foo-test-pconst f "test"))
(if (not (string=? p "test_pconst"))
(error "member-test_pconst failed!"))
(set! p (Foo-test-constm f "test"))
(if (not (string=? p "test_constmethod"))
(error "member-test_constm failed!"))
(set! p (Foo-test-pconstm f "test"))
(if (not (string=? p "test_pconstmethod"))
(error "member-test_pconstm failed!"))
(exit 0)
(load "../schemerunme/constover.scm")

16
Examples/test-suite/guile/contract_runme.scm
View file

@ -3,18 +3,4 @@
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_contract_module" (dynamic-link "./libcontract.so"))
(load "testsuite.scm")
(test-preassert 1 2)
(expect-throw 'swig-contract-assertion-failed
(test-preassert -1 2))
(test-postassert 3)
(expect-throw 'swig-contract-assertion-failed
(test-postassert -3))
(test-prepost 2 3)
(test-prepost 5 -4)
(expect-throw 'swig-contract-assertion-failed
(test-prepost -3 4))
(expect-throw 'swig-contract-assertion-failed
(test-prepost 4 -10))
(quit)
(load "../schemerunme/contract.scm")

44
Examples/test-suite/guile/cpp_namespace_runme.scm
View file

@ -1,44 +1,2 @@
(dynamic-call "scm_init_cpp_namespace_module" (dynamic-link "./libcpp_namespace.so"))
(define n (fact 4))
(if (not (= n 24))
(error "Bad return value!"))
(if (not (= (Foo) 42))
(error "bad variable value!"))
(define t (new-Test))
(if (not (string=? (Test-method t) "Test::method"))
(error "Bad method return value!"))
(if (not (string=? (do-method t) "Test::method"))
(error "Bad return value!"))
(if (not (string=? (do-method2 t) "Test::method"))
(error "Bad return value!"))
(weird "hello" 4)
;; (delete-Test t)
(define t2 (new-Test2))
(define t3 (new-Test3))
(define t4 (new-Test4))
(define t5 (new-Test5))
(if (not (= (foo3 42) 42))
(error "Bad return value!"))
(if (not (string=? (do-method3 t2 40) "Test2::method"))
(error "bad return value!"))
(if (not (string=? (do-method3 t3 40) "Test3::method"))
(error "bad return value"))
(if (not (string=? (do-method3 t4 40) "Test4::method"))
(error "bad return value"))
(if (not (string=? (do-method3 t5 40) "Test5::method"))
(error "bad return value"))
(exit 0)
(load "../schemerunme/cpp_namespace.scm")

13
Examples/test-suite/guile/dynamic_cast_runme.scm
View file

@ -1,13 +1,2 @@
(dynamic-call "scm_init_dynamic_cast_module" (dynamic-link "./libdynamic_cast.so"))
(define f (new-Foo))
(define b (new-Bar))
(define x (Foo-blah f))
(define y (Bar-blah b))
(define a (do-test y))
(if (not (string=? a "Bar::test"))
(error "Failed!"))
(exit 0)
(load "../schemerunme/dynamic_cast.scm")

9
Examples/test-suite/guile/import_nomodule_runme.scm
View file

@ -1,9 +1,2 @@
(dynamic-call "scm_init_import_nomodule_module" (dynamic-link "./libimport_nomodule.so"))
(define f (create-Foo))
(test1 f 42)
(define b (new-Bar))
(test1 b 37)
(exit 0)
(load "../schemerunme/import_nomodule.scm")

10
Examples/test-suite/guile/imports_runme.scm
View file

@ -8,12 +8,4 @@
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_imports_a_module" (dynamic-link "./libimports_a.so"))
(dynamic-call "scm_init_imports_b_module" (dynamic-link "./libimports_b.so"))
(define x (new-B))
;; This fails in 1.3a5 because the SWIG runtime code does not know
;; that x (an instance of class B) can be passed to methods of class A.
(A-hello x)
(exit 0)
(load "../schemerunme/imports.scm")

16
Examples/test-suite/guile/inherit_missing_runme.scm
View file

@ -1,16 +1,2 @@
(dynamic-call "scm_init_inherit_missing_module" (dynamic-link "./libinherit_missing.so"))
(define a (new-Foo))
(define b (new-Bar))
(define c (new-Spam))
(if (not (string=? (do-blah a) "Foo::blah"))
(error "Bad return"))
(if (not (string=? (do-blah b) "Bar::blah"))
(error "Bad return"))
(if (not (string=? (do-blah c) "Spam::blah"))
(error "bad return"))
(exit 0)
(load "../schemerunme/inherit_missing.scm")

28
Examples/test-suite/guile/list_vector_runme.scm
View file

@ -2,30 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_list_vector_module" (dynamic-link "./liblist_vector.so"))
(define-macro (check-equality form1 form2)
`(let ((result1 ,form1)
(result2 ,form2))
(if (not (equal? result1 result2))
(error "Check failed:"
(list 'equal? ',form1 ',form2)
result1 result2))))
(check-equality (sum-list '(1 3 4 6 7)) 21.0)
(check-equality (sum-vector #(2 4 6 7 9)) 28.0)
(check-equality (one-to-seven-list) '(1 2 3 4 5 6 7))
(check-equality (one-to-seven-vector) #(1 2 3 4 5 6 7))
(check-equality (sum-list2 '(1 3 4 6 7)) 21.0)
(check-equality (sum-vector2 #(2 4 6 7 9)) 28.0)
(check-equality (one-to-seven-list2) '(1 2 3 4 5 6 7))
(check-equality (one-to-seven-vector2) #(1 2 3 4 5 6 7))
(check-equality (sum-lists '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
(check-equality (sum-lists2 '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
(check-equality (call-with-values produce-lists list)
'(#(0 1 2 3 4)
#(0 1 4 9 16)
#(0.0 1.5 3.0 4.5 6.0)))
(exit 0)
(load "../schemerunme/list_vector.scm")

19
Examples/test-suite/guile/multivalue_runme.scm
View file

@ -4,21 +4,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_test_module" (dynamic-link "./libmultivalue.so"))
(let ((quotient/remainder (divide-l 37 5)))
(if (not (equal? quotient/remainder '(7 2)))
(exit 1)))
(let ((quotient-remainder-vector (divide-v 41 7)))
(if (not (equal? quotient-remainder-vector #(5 6)))
(exit 1)))
(call-with-values (lambda ()
(divide-mv 91 13))
(lambda (quotient remainder)
(if (not (and (= quotient 7)
(= remainder 0)))
(exit 1))))
(exit 0)
(load "../schemerunme/multivalue.scm")

7
Examples/test-suite/guile/name_runme.scm
View file

@ -2,9 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_name_module" (dynamic-link "./libname.so"))
(foo-2)
bar-2
Baz-2
(exit 0)
(load "../schemerunme/name.scm")

6
Examples/test-suite/guile/overload_copy_runme.scm
View file

@ -1,6 +1,2 @@
(dynamic-call "scm_init_overload_copy_module" (dynamic-link "./liboverload_copy.so"))
(define f (new-Foo))
(define g (new-Foo f))
(exit 0)
(load "../schemerunme/overload_copy.scm")

14
Examples/test-suite/guile/overload_extend_runme.scm
View file

@ -1,14 +1,2 @@
(dynamic-call "scm_init_overload_extend_module" (dynamic-link "./liboverload_extend.so"))
(define f (new-Foo))
(if (not (= (Foo-test f 3) 1))
(error "test integer bad"))
(if (not (= (Foo-test f "hello") 2))
(error "test string bad"))
(if (not (= (Foo-test f 3.5 2.5) 3))
(error "test reals bad"))
(exit 0)
(load "../schemerunme/overload_extend.scm")

53
Examples/test-suite/guile/overload_simple_runme.scm
View file

@ -2,55 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_overload_simple_module" (dynamic-link "./liboverload_simple.so"))
(if (not (string=? (foo 3) "foo:int"))
(error "foo(int)"))
(if (not (string=? (foo 3.01) "foo:double"))
(error "foo(double)"))
(if (not (string=? (foo "hello") "foo:char *"))
(error "foo(char *)"))
(let ((f (new-Foo))
(b (new-Bar))
(s (new-Spam)))
(if (not (string=? (foo f) "foo:Foo *"))
(error "foo(Foo *)"))
(if (not (string=? (foo b) "foo:Bar *"))
(error "foo(Bar *)"))
;; Test member functions
(if (not (string=? (Spam-foo s 3) "foo:int"))
(error "Spam::foo(int)"))
(if (not (string=? (Spam-foo s 3.01) "foo:double"))
(error "Spam::foo(double)"))
(if (not (string=? (Spam-foo s "hello") "foo:char *"))
(error "Spam::foo(char *)"))
(if (not (string=? (Spam-foo s f) "foo:Foo *"))
(error "Spam::foo(Foo *)"))
(if (not (string=? (Spam-foo s b) "foo:Bar *"))
(error "Spam::foo(Bar *)"))
;; Test static member functions
(if (not (string=? (Spam-bar 3) "bar:int"))
(error "Spam::bar(int)"))
(if (not (string=? (Spam-bar 3.01) "bar:double"))
(error "Spam::bar(double)"))
(if (not (string=? (Spam-bar "hello") "bar:char *"))
(error "Spam::bar(char *)"))
(if (not (string=? (Spam-bar f) "bar:Foo *"))
(error "Spam::bar(Foo *)"))
(if (not (string=? (Spam-bar b) "bar:Bar *"))
(error "Spam::bar(Bar *)"))
;; Test constructors
(if (not (string=? (Spam-type-get (new-Spam)) "none"))
(error "Spam()"))
(if (not (string=? (Spam-type-get (new-Spam 3)) "int"))
(error "Spam(int)"))
(if (not (string=? (Spam-type-get (new-Spam 3.4)) "double"))
(error "Spam(double)"))
(if (not (string=? (Spam-type-get (new-Spam "hello")) "char *"))
(error "Spam(char *)"))
(if (not (string=? (Spam-type-get (new-Spam b)) "Bar *"))
(error "Spam(Bar *)")))
(exit 0)
(load "../schemerunme/overload_simple.scm")

9
Examples/test-suite/guile/overload_subtype_runme.scm
View file

@ -2,11 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_overload_subtype_module" (dynamic-link "./liboverload_subtype.so"))
(if (not (= (spam (new-Foo)) 1))
(error "foo"))
(if (not (= (spam (new-Bar)) 2))
(error "bar"))
(exit 0)
(load "../schemerunme/overload_subtype.scm")

15
Examples/test-suite/guile/pointer_in_out_runme.scm
View file

@ -2,17 +2,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_pointer_in_out_module" (dynamic-link "./libpointer_in_out.so"))
(define-macro (check form)
`(if (not ,form)
(error "Check failed: " ',form)))
(define p (produce-int-pointer 47 11))
(check (= (consume-int-pointer p) 47))
(define q (frobnicate-int-pointer p))
(check (= (consume-int-pointer q) 11))
(exit 0)
(load "../schemerunme/pointer_in_out.scm")

61
Examples/test-suite/guile/reference_global_vars_runme.scm
View file

@ -1,62 +1,3 @@
; copied from python runme_.py
(dynamic-call "scm_init_reference_global_vars_module" (dynamic-link "./libreference_global_vars.so"))
(define (!= a b) (not (= a b)))
; const class reference variable
(if (!= (TestClass-num-get (getconstTC)) 33)
(begin (display "Runtime test 1 failed.\n") (exit 1)))
; primitive reference variables
(var-bool (createref-bool #f))
(if (value-bool (var-bool))
(begin (display "Runtime test 2 failed.\n") (exit 1)))
(var-char (createref-char #\w))
(if (not (char=? (value-char (var-char)) #\w))
(begin (display "Runtime test 3 failed.\n") (exit 1)))
(var-unsigned-char (createref-unsigned-char #\nl))
(if (not (char=? (value-unsigned-char (var-unsigned-char)) #\nl))
(begin (display "Runtime test 4 failed.\n") (exit 1)))
(var-signed-char (createref-signed-char #\nl))
(if (not (char=? (value-signed-char (var-signed-char)) #\nl))
(begin (display "Runtime test 5 failed.\n") (exit 1)))
(var-unsigned-short (createref-unsigned-short 10))
(if (!= (value-unsigned-short (var-unsigned-short)) 10)
(begin (display "Runtime test 6 failed.\n") (exit 1)))
(var-int (createref-int 10))
(if (!= (value-int (var-int)) 10)
(begin (display "Runtime test 7 failed.\n") (exit 1)))
(var-unsigned-int (createref-unsigned-int 10))
(if (!= (value-unsigned-int (var-unsigned-int)) 10)
(begin (display "Runtime test 8 failed.\n") (exit 1)))
(var-long (createref-long 10))
(if (!= (value-long (var-long)) 10)
(begin (display "Runtime test 9 failed.\n") (exit 1)))
(var-unsigned-long (createref-unsigned-long 10))
(if (!= (value-unsigned-long (var-unsigned-long)) 10)
(begin (display "Runtime test 10 failed.\n") (exit 1)))
;skip long long and unsigned long long
(var-float (createref-float 10.5))
(if (!= (value-float (var-float)) 10.5)
(begin (display "Runtime test 11 failed.\n") (exit 1)))
(var-double (createref-double 10.55))
(if (!= (value-double (var-double)) 10.55)
(begin (display "Runtime test 12 failed.\n") (exit 1)))
;class reference
(var-TestClass (createref-TestClass (new-TestClass 20)))
(if (!= (TestClass-num-get (value-TestClass (var-TestClass))) 20)
(begin (display "Runtime test 13 failed.\n") (exit 1)))
(exit 0)
(load "../schemerunme/reference_global_vars.scm")

21
Examples/test-suite/guile/typedef_inherit_runme.scm
View file

@ -1,21 +1,2 @@
(dynamic-call "scm_init_typedef_inherit_module" (dynamic-link "./libtypedef_inherit.so"))
(define a (new-Foo))
(define b (new-Bar))
(if (not (string=? (do-blah a) "Foo::blah"))
(error "bad return"))
(if (not (string=? (do-blah b) "Bar::blah"))
(error "bad return"))
(define c (new-Spam))
(define d (new-Grok))
(if (not (string=? (do-blah2 c) "Spam::blah"))
(error "bad return"))
(if (not (string=? (do-blah2 d) "Grok::blah"))
(error "bad return"))
(exit 0)
(load "../schemerunme/typedef_inherit.scm")

14
Examples/test-suite/guile/typename_runme.scm
View file

@ -1,15 +1,3 @@
(dynamic-call "scm_init_typename_module" (dynamic-link "./libtypename.so"))
;;(dynamic-call "scm_init_types_module" (dynamic-link "./libtypes.so"))
(define f (new-Foo))
(define b (new-Bar))
(define x (twoFoo f))
;;(if (not (isinstance x (types-FloatType)))
;; (error "wrong return type"))
(define y (twoBar b))
;;(if (not (isinstance y (types-IntType)))
;; (error "wrong return type"))
(exit 0)
(load "../schemerunme/typename.scm")

35
Examples/test-suite/guile/unions_runme.scm
View file

@ -5,37 +5,4 @@
;; Guile modules (namespaces) but simply put all the bindings into the
;; current module. That's enough for such a simple test.
(dynamic-call "scm_init_unions_module" (dynamic-link "./libunions.so"))
;; Create new instances of SmallStruct and BigStruct for later use
(define small (new-SmallStruct))
(SmallStruct-jill-set small 200)
(define big (new-BigStruct))
(BigStruct-smallstruct-set big small)
(BigStruct-jack-set big 300)
;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
;; Ensure values in EmbeddedUnionTest are set correctly for each.
(define eut (new-EmbeddedUnionTest))
;; First check the SmallStruct in EmbeddedUnionTest
(EmbeddedUnionTest-number-set eut 1)
(EmbeddedUnionTest-uni-small-set (EmbeddedUnionTest-uni-get eut)
small)
(let ((Jill1 (SmallStruct-jill-get
(EmbeddedUnionTest-uni-small-get
(EmbeddedUnionTest-uni-get eut)))))
(if (not (= Jill1 200))
(begin
(display "Runtime test 1 failed.")
(exit 1))))
(let ((Num1 (EmbeddedUnionTest-number-get eut)))
(if (not (= Num1 1))
(begin
(display "Runtime test 2 failed.")
(exit 1))))
;; that should do
(exit 0)
(load "../schemerunme/unions.scm")

2
Examples/test-suite/multivalue.i
View file

@ -1,6 +1,6 @@
/* -*- c -*- */
%module test
%module multivalue
#ifdef SWIGGUILE

8
Examples/test-suite/schemerunme/casts.scm Normal file
View file

@ -0,0 +1,8 @@
(define x (new-B))
;; This fails in 1.3a5 because the SWIG/Guile runtime code gets the
;; source and the target of a cast the wrong way around.
(A-hello x)
(exit 0)

4
Examples/test-suite/schemerunme/char_constant.scm Normal file
View file

@ -0,0 +1,4 @@
(if (and (char? (CHAR-CONSTANT))
(string? (STRING-CONSTANT)))
(exit 0)
(exit 1))

6
Examples/test-suite/schemerunme/class_ignore.scm Normal file
View file

@ -0,0 +1,6 @@
(define a (new-Bar))
(if (not (string=? (Bar-blah a) "Bar::blah"))
(error "Wrong string"))
(exit 0)

26
Examples/test-suite/schemerunme/constover.scm Normal file
View file

@ -0,0 +1,26 @@
(define p (test "test"))
(if (not (string=? p "test"))
(error "test failed!"))
(set! p (test-pconst "test"))
(if (not (string=? p "test_pconst"))
(error "test_pconst failed!"))
(define f (new-Foo))
(set! p (Foo-test f "test"))
(if (not (string=? p "test"))
(error "member-test failed!"))
(set! p (Foo-test-pconst f "test"))
(if (not (string=? p "test_pconst"))
(error "member-test_pconst failed!"))
(set! p (Foo-test-constm f "test"))
(if (not (string=? p "test_constmethod"))
(error "member-test_constm failed!"))
(set! p (Foo-test-pconstm f "test"))
(if (not (string=? p "test_pconstmethod"))
(error "member-test_pconstm failed!"))
(exit 0)

14
Examples/test-suite/schemerunme/contract.scm Normal file
View file

@ -0,0 +1,14 @@
(test-preassert 1 2)
(expect-throw 'swig-contract-assertion-failed
(test-preassert -1 2))
(test-postassert 3)
(expect-throw 'swig-contract-assertion-failed
(test-postassert -3))
(test-prepost 2 3)
(test-prepost 5 -4)
(expect-throw 'swig-contract-assertion-failed
(test-prepost -3 4))
(expect-throw 'swig-contract-assertion-failed
(test-prepost 4 -10))
(quit)

42
Examples/test-suite/schemerunme/cpp_namespace.scm Normal file
View file

@ -0,0 +1,42 @@
(define n (fact 4))
(if (not (= n 24))
(error "Bad return value!"))
(if (not (= (Foo) 42))
(error "bad variable value!"))
(define t (new-Test))
(if (not (string=? (Test-method t) "Test::method"))
(error "Bad method return value!"))
(if (not (string=? (do-method t) "Test::method"))
(error "Bad return value!"))
(if (not (string=? (do-method2 t) "Test::method"))
(error "Bad return value!"))
(weird "hello" 4)
;; (delete-Test t)
(define t2 (new-Test2))
(define t3 (new-Test3))
(define t4 (new-Test4))
(define t5 (new-Test5))
(if (not (= (foo3 42) 42))
(error "Bad return value!"))
(if (not (string=? (do-method3 t2 40) "Test2::method"))
(error "bad return value!"))
(if (not (string=? (do-method3 t3 40) "Test3::method"))
(error "bad return value"))
(if (not (string=? (do-method3 t4 40) "Test4::method"))
(error "bad return value"))
(if (not (string=? (do-method3 t5 40) "Test5::method"))
(error "bad return value"))
(exit 0)

11
Examples/test-suite/schemerunme/dynamic_cast.scm Normal file
View file

@ -0,0 +1,11 @@
(define f (new-Foo))
(define b (new-Bar))
(define x (Foo-blah f))
(define y (Bar-blah b))
(define a (do-test y))
(if (not (string=? a "Bar::test"))
(error "Failed!"))
(exit 0)

7
Examples/test-suite/schemerunme/import_nomodule.scm Normal file
View file

@ -0,0 +1,7 @@
(define f (create-Foo))
(test1 f 42)
(define b (new-Bar))
(test1 b 37)
(exit 0)

13
Examples/test-suite/schemerunme/imports.scm Normal file
View file

@ -0,0 +1,13 @@
;;; This file is part of a test for SF bug #231619.
;;; It shows that the %import directive does not work properly in SWIG
;;; 1.3a5: Type information is not properly generated if a base class
;;; comes from an %import-ed file.
(define x (new-B))
;; This fails in 1.3a5 because the SWIG runtime code does not know
;; that x (an instance of class B) can be passed to methods of class A.
(A-hello x)
(exit 0)

14
Examples/test-suite/schemerunme/inherit_missing.scm Normal file
View file

@ -0,0 +1,14 @@
(define a (new-Foo))
(define b (new-Bar))
(define c (new-Spam))
(if (not (string=? (do-blah a) "Foo::blah"))
(error "Bad return"))
(if (not (string=? (do-blah b) "Bar::blah"))
(error "Bad return"))
(if (not (string=? (do-blah c) "Spam::blah"))
(error "bad return"))
(exit 0)

26
Examples/test-suite/schemerunme/list_vector.scm Normal file
View file

@ -0,0 +1,26 @@
(define-macro (check-equality form1 form2)
`(let ((result1 ,form1)
(result2 ,form2))
(if (not (equal? result1 result2))
(error "Check failed:"
(list 'equal? ',form1 ',form2)
result1 result2))))
(check-equality (sum-list '(1 3 4 6 7)) 21.0)
(check-equality (sum-vector #(2 4 6 7 9)) 28.0)
(check-equality (one-to-seven-list) '(1 2 3 4 5 6 7))
(check-equality (one-to-seven-vector) #(1 2 3 4 5 6 7))
(check-equality (sum-list2 '(1 3 4 6 7)) 21.0)
(check-equality (sum-vector2 #(2 4 6 7 9)) 28.0)
(check-equality (one-to-seven-list2) '(1 2 3 4 5 6 7))
(check-equality (one-to-seven-vector2) #(1 2 3 4 5 6 7))
(check-equality (sum-lists '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
(check-equality (sum-lists2 '(1 2 3) '(4 5 6) '(7 8 9)) 45.0)
(check-equality (call-with-values produce-lists list)
'(#(0 1 2 3 4)
#(0 1 4 9 16)
#(0.0 1.5 3.0 4.5 6.0)))
(exit 0)

19
Examples/test-suite/schemerunme/multivalue.scm Normal file
View file

@ -0,0 +1,19 @@
;;;; Automatic test of multiple return values
(let ((quotient/remainder (divide-l 37 5)))
(if (not (equal? quotient/remainder '(7 2)))
(exit 1)))
(let ((quotient-remainder-vector (divide-v 41 7)))
(if (not (equal? quotient-remainder-vector #(5 6)))
(exit 1)))
(call-with-values (lambda ()
(divide-mv 91 13))
(lambda (quotient remainder)
(if (not (and (= quotient 7)
(= remainder 0)))
(exit 1))))
(exit 0)

5
Examples/test-suite/schemerunme/name.scm Normal file
View file

@ -0,0 +1,5 @@
(foo-2)
bar-2
Baz-2
(exit 0)

16
Examples/test-suite/schemerunme/overload_complicated.scm Normal file
View file

@ -0,0 +1,16 @@
(define-macro (check form)
`(if (not ,form)
(error "Check failed: " ',form)))
(define (=~ a b)
(< (abs (- a b)) 1e-8))
;; Check first method
(check (=~ (foo 1 2 "bar" 4) 15))
;; Check second method
(check (=~ (foo 1 2) 4811.4))
(check (=~ (foo 1 2 3.2) 4797.2))
(check (=~ (foo 1 2 3.2 #\Q) 4798.2))
(exit 0)

4
Examples/test-suite/schemerunme/overload_copy.scm Normal file
View file

@ -0,0 +1,4 @@
(define f (new-Foo))
(define g (new-Foo f))
(exit 0)

12
Examples/test-suite/schemerunme/overload_extend.scm Normal file
View file

@ -0,0 +1,12 @@
(define f (new-Foo))
(if (not (= (Foo-test f 3) 1))
(error "test integer bad"))
(if (not (= (Foo-test f "hello") 2))
(error "test string bad"))
(if (not (= (Foo-test f 3.5 2.5) 3))
(error "test reals bad"))
(exit 0)

51
Examples/test-suite/schemerunme/overload_simple.scm Normal file
View file

@ -0,0 +1,51 @@
(if (not (string=? (foo 3) "foo:int"))
(error "foo(int)"))
(if (not (string=? (foo 3.01) "foo:double"))
(error "foo(double)"))
(if (not (string=? (foo "hello") "foo:char *"))
(error "foo(char *)"))
(let ((f (new-Foo))
(b (new-Bar))
(s (new-Spam)))
(if (not (string=? (foo f) "foo:Foo *"))
(error "foo(Foo *)"))
(if (not (string=? (foo b) "foo:Bar *"))
(error "foo(Bar *)"))
;; Test member functions
(if (not (string=? (Spam-foo s 3) "foo:int"))
(error "Spam::foo(int)"))
(if (not (string=? (Spam-foo s 3.01) "foo:double"))
(error "Spam::foo(double)"))
(if (not (string=? (Spam-foo s "hello") "foo:char *"))
(error "Spam::foo(char *)"))
(if (not (string=? (Spam-foo s f) "foo:Foo *"))
(error "Spam::foo(Foo *)"))
(if (not (string=? (Spam-foo s b) "foo:Bar *"))
(error "Spam::foo(Bar *)"))
;; Test static member functions
(if (not (string=? (Spam-bar 3) "bar:int"))
(error "Spam::bar(int)"))
(if (not (string=? (Spam-bar 3.01) "bar:double"))
(error "Spam::bar(double)"))
(if (not (string=? (Spam-bar "hello") "bar:char *"))
(error "Spam::bar(char *)"))
(if (not (string=? (Spam-bar f) "bar:Foo *"))
(error "Spam::bar(Foo *)"))
(if (not (string=? (Spam-bar b) "bar:Bar *"))
(error "Spam::bar(Bar *)"))
;; Test constructors
(if (not (string=? (Spam-type-get (new-Spam)) "none"))
(error "Spam()"))
(if (not (string=? (Spam-type-get (new-Spam 3)) "int"))
(error "Spam(int)"))
(if (not (string=? (Spam-type-get (new-Spam 3.4)) "double"))
(error "Spam(double)"))
(if (not (string=? (Spam-type-get (new-Spam "hello")) "char *"))
(error "Spam(char *)"))
(if (not (string=? (Spam-type-get (new-Spam b)) "Bar *"))
(error "Spam(Bar *)")))
(exit 0)

7
Examples/test-suite/schemerunme/overload_subtype.scm Normal file
View file

@ -0,0 +1,7 @@
(if (not (= (spam (new-Foo)) 1))
(error "foo"))
(if (not (= (spam (new-Bar)) 2))
(error "bar"))
(exit 0)

13
Examples/test-suite/schemerunme/pointer_in_out.scm Normal file
View file

@ -0,0 +1,13 @@
(define-macro (check form)
`(if (not ,form)
(error "Check failed: " ',form)))
(define p (produce-int-pointer 47 11))
(check (= (consume-int-pointer p) 47))
(define q (frobnicate-int-pointer p))
(check (= (consume-int-pointer q) 11))
(exit 0)

59
Examples/test-suite/schemerunme/reference_global_vars.scm Normal file
View file

@ -0,0 +1,59 @@
(define (!= a b) (not (= a b)))
; const class reference variable
(if (!= (TestClass-num-get (getconstTC)) 33)
(begin (display "Runtime test 1 failed.\n") (exit 1)))
; primitive reference variables
(var-bool (createref-bool #f))
(if (value-bool (var-bool))
(begin (display "Runtime test 2 failed.\n") (exit 1)))
(var-char (createref-char #\w))
(if (not (char=? (value-char (var-char)) #\w))
(begin (display "Runtime test 3 failed.\n") (exit 1)))
(var-unsigned-char (createref-unsigned-char #\nl))
(if (not (char=? (value-unsigned-char (var-unsigned-char)) #\nl))
(begin (display "Runtime test 4 failed.\n") (exit 1)))
(var-signed-char (createref-signed-char #\nl))
(if (not (char=? (value-signed-char (var-signed-char)) #\nl))
(begin (display "Runtime test 5 failed.\n") (exit 1)))
(var-unsigned-short (createref-unsigned-short 10))
(if (!= (value-unsigned-short (var-unsigned-short)) 10)
(begin (display "Runtime test 6 failed.\n") (exit 1)))
(var-int (createref-int 10))
(if (!= (value-int (var-int)) 10)
(begin (display "Runtime test 7 failed.\n") (exit 1)))
(var-unsigned-int (createref-unsigned-int 10))
(if (!= (value-unsigned-int (var-unsigned-int)) 10)
(begin (display "Runtime test 8 failed.\n") (exit 1)))
(var-long (createref-long 10))
(if (!= (value-long (var-long)) 10)
(begin (display "Runtime test 9 failed.\n") (exit 1)))
(var-unsigned-long (createref-unsigned-long 10))
(if (!= (value-unsigned-long (var-unsigned-long)) 10)
(begin (display "Runtime test 10 failed.\n") (exit 1)))
;skip long long and unsigned long long
(var-float (createref-float 10.5))
(if (!= (value-float (var-float)) 10.5)
(begin (display "Runtime test 11 failed.\n") (exit 1)))
(var-double (createref-double 10.55))
(if (!= (value-double (var-double)) 10.55)
(begin (display "Runtime test 12 failed.\n") (exit 1)))
;class reference
(var-TestClass (createref-TestClass (new-TestClass 20)))
(if (!= (TestClass-num-get (value-TestClass (var-TestClass))) 20)
(begin (display "Runtime test 13 failed.\n") (exit 1)))
(exit 0)

19
Examples/test-suite/schemerunme/typedef_inherit.scm Normal file
View file

@ -0,0 +1,19 @@
(define a (new-Foo))
(define b (new-Bar))
(if (not (string=? (do-blah a) "Foo::blah"))
(error "bad return"))
(if (not (string=? (do-blah b) "Bar::blah"))
(error "bad return"))
(define c (new-Spam))
(define d (new-Grok))
(if (not (string=? (do-blah2 c) "Spam::blah"))
(error "bad return"))
(if (not (string=? (do-blah2 d) "Grok::blah"))
(error "bad return"))
(exit 0)

12
Examples/test-suite/schemerunme/typename.scm Normal file
View file

@ -0,0 +1,12 @@
(define f (new-Foo))
(define b (new-Bar))
(define x (twoFoo f))
;;(if (not (isinstance x (types-FloatType)))
;; (error "wrong return type"))
(define y (twoBar b))
;;(if (not (isinstance y (types-IntType)))
;; (error "wrong return type"))
(exit 0)

36
Examples/test-suite/schemerunme/unions.scm Normal file
View file

@ -0,0 +1,36 @@
;;; This is the union runtime testcase. It ensures that values within a
;;; union embedded within a struct can be set and read correctly.
;; Create new instances of SmallStruct and BigStruct for later use
(define small (new-SmallStruct))
(SmallStruct-jill-set small 200)
(define big (new-BigStruct))
(BigStruct-smallstruct-set big small)
(BigStruct-jack-set big 300)
;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest.
;; Ensure values in EmbeddedUnionTest are set correctly for each.
(define eut (new-EmbeddedUnionTest))
;; First check the SmallStruct in EmbeddedUnionTest
(EmbeddedUnionTest-number-set eut 1)
(EmbeddedUnionTest-uni-small-set (EmbeddedUnionTest-uni-get eut)
small)
(let ((Jill1 (SmallStruct-jill-get
(EmbeddedUnionTest-uni-small-get
(EmbeddedUnionTest-uni-get eut)))))
(if (not (= Jill1 200))
(begin
(display "Runtime test 1 failed.")
(exit 1))))
(let ((Num1 (EmbeddedUnionTest-number-get eut)))
(if (not (= Num1 1))
(begin
(display "Runtime test 2 failed.")
(exit 1))))
;; that should do
(exit 0)

14
Lib/chicken/chicken.swg
View file

@ -595,17 +595,21 @@ SWIGEXPORT(void)
$realmodule_swig_init(int argc, C_word closure, C_word continuation) {
static int typeinit = 0;
int i;
C_word sym;
C_word tmp;
C_word *a;
C_word ret;
if (!typeinit) {
for (i = 0; swig_types_initial[i]; i++) {
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
}
typeinit = 1;
swig_init_helper (continuation);
ret = C_SCHEME_TRUE;
} else {
ret = C_SCHEME_FALSE;
}
else {
C_kontinue (continuation, C_SCHEME_FALSE);
}
}
a = C_alloc(2*$nummethods$symsize);
%}

34
Source/Modules/chicken.cxx
View file

@ -55,7 +55,6 @@ static int num_methods = 0;
static File *f_runtime = 0;
static File *f_header = 0;
static File *f_wrappers = 0;
static File *f_init_helper = 0;
static File *f_sym_size = 0;
static File *f_init = 0;
static File *f_scm = 0;
@ -220,7 +219,6 @@ CHICKEN::top(Node *n)
SWIG_exit(EXIT_FAILURE);
}
f_sym_size = NewString("");
f_init_helper = NewString("\n");
f_init = NewString("");
f_header = NewString("");
f_wrappers = NewString("");
@ -232,7 +230,6 @@ CHICKEN::top(Node *n)
Swig_register_filebyname("header",f_header);
Swig_register_filebyname("wrapper",f_wrappers);
Swig_register_filebyname("runtime",f_runtime);
Swig_register_filebyname("init_helper",f_init_helper);
Swig_register_filebyname("init",f_init);
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
@ -331,14 +328,6 @@ CHICKEN::top(Node *n)
Printf(f_wrappers,"extern \"C\" {\n");
Printf(f_wrappers,"#endif\n\n");
Printf(f_init_helper,
"static void swig_init_helper (C_word continuation) C_noret;\n");
Printf(f_init_helper,
"static void swig_init_helper (C_word continuation) {\n");
Printf(f_init_helper, "C_word sym;\n");
Printf(f_init_helper, "C_word tmp;\n");
Printf(f_init_helper, "C_word *a = C_alloc (2*$nummethods$symsize);\n");
#ifdef INIT_BINDING
{
String *tmp = NewString("");
@ -361,12 +350,13 @@ CHICKEN::top(Node *n)
Printf(f_wrappers,"}\n");
Printf(f_wrappers,"#endif\n");
Printf(f_init_helper, "C_kontinue (continuation, C_SCHEME_TRUE);\n");
Printf(f_init_helper, "}\n");
Printf(f_init, "C_kontinue (continuation, ret);\n");
Printf(f_init, "}\n\n");
char buftmp[20];
sprintf(buftmp, "%d", num_methods);
Replaceall(f_init_helper, "$nummethods", buftmp);
Replaceall(f_init_helper, "$symsize", f_sym_size);
Replaceall(f_init, "$nummethods", buftmp);
Replaceall(f_init, "$symsize", f_sym_size);
Delete(chicken_filename);
Delete(clos_filename);
@ -392,12 +382,10 @@ CHICKEN::top(Node *n)
/* Close all of the files */
Dump(f_header,f_runtime);
Dump(f_wrappers,f_runtime);
Wrapper_pretty_print(f_init_helper,f_runtime);
Wrapper_pretty_print(f_init,f_runtime);
Delete(f_header);
Delete(f_wrappers);
Delete(f_sym_size);
Delete(f_init_helper);
Delete(f_init);
Close(f_runtime);
Delete(f_runtime);
@ -550,10 +538,10 @@ CHICKEN::functionWrapper(Node *n)
Delete(cn);
}
else {
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
/*Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
"Unable to find \"%%typemap(clos_in) %s *\" "
"or typemaps for any superclasses.\n",
SwigType_str(pb,0));
SwigType_str(pb,0));*/
}
}
if (!gotwrap) {
@ -746,10 +734,10 @@ CHICKEN::functionWrapper(Node *n)
closparam = Copy(tm);
}
else {
Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
/*Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
"Unable to find \"%%typemap(clos_out) %s *\" "
"or typemaps for any superclasses.\n",
SwigType_str(pb,0));
SwigType_str(pb,0));*/
}
}
@ -1680,9 +1668,9 @@ CHICKEN::addMethod(String *, String *scheme_name, String *function)
/* add symbol to Chicken internal symbol table */
Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
Printf(f_init_helper, "sym = C_intern (&a, %d, \"%s\");\n",
Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n",
Len(sym), sym);
Printv(f_init_helper,
Printv(f_init,
"C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)",
function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
num_methods++;