From 420ba48099c9debe85e76b28b7ef7b2e05d5bed5 Mon Sep 17 00:00:00 2001 From: John Lenz Date: Fri, 15 Apr 2005 05:23:14 +0000 Subject: [PATCH] Add a whole bunch of chicken runme scripts, and fix the bugs exposed by those scripts git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@7155 626c5289-ae23-0410-ae9c-e8d60b6d4f22 --- SWIG/CHANGES.current | 10 + SWIG/Doc/Manual/Chicken.html | 21 +- SWIG/Examples/chicken/README | 2 - SWIG/Examples/chicken/class/Makefile | 2 +- .../chicken/class/test-lowlevel-class.scm | 5 +- .../chicken/class/test-tinyclos-class.scm | 6 +- .../chicken/constants/test-constants.scm | 4 +- .../chicken/multimap/test-multimap.scm | 1 - .../chicken/overload/test-overload.scm | 4 +- SWIG/Examples/chicken/simple/example.i | 2 +- SWIG/Examples/chicken/simple/test-simple.scm | 18 - SWIG/Examples/chicken/zlib/Makefile | 13 +- SWIG/Examples/chicken/zlib/test-zlib.scm | 48 +- SWIG/Examples/test-suite/chicken/Makefile.in | 12 +- .../test-suite/chicken/casts_runme.ss | 2 +- .../test-suite/chicken/char_constant_runme.ss | 2 +- .../test-suite/chicken/class_ignore_runme.ss | 2 +- .../chicken/clientdata_prop_runme_proxy.ss | 95 ++++ .../test-suite/chicken/constover_runme.ss | 2 +- .../test-suite/chicken/contract_runme.ss | 2 +- .../chicken/cpp_basic_runme_proxy.ss | 51 ++ .../test-suite/chicken/cpp_enum_runme.ss | 2 +- .../test-suite/chicken/cpp_namespace_runme.ss | 2 +- .../test-suite/chicken/dynamic_cast_runme.ss | 2 +- .../test-suite/chicken/global_vars_runme.ss | 2 + .../chicken/global_vars_runme_proxy.ss | 2 + .../chicken/import_nomodule_runme.ss | 2 +- .../test-suite/chicken/imports_runme.ss | 4 +- .../chicken/inherit_missing_runme.ss | 2 +- .../test-suite/chicken/li_std_string_runme.ss | 2 +- .../chicken/li_std_string_runme_proxy.ss | 48 ++ .../test-suite/chicken/li_typemaps_runme.ss | 2 + .../chicken/li_typemaps_runme_proxy.ss | 2 + .../test-suite/chicken/list_vector_runme.ss | 2 +- .../multiple_inheritance_runme_proxy.ss | 2 + .../test-suite/chicken/multivalue_runme.ss | 2 +- .../Examples/test-suite/chicken/name_runme.ss | 2 +- .../chicken/newobject1_runme_proxy.ss | 30 + .../test-suite/chicken/newobject2_runme.ss | 2 +- .../chicken/newobject2_runme_proxy.ss | 2 +- .../chicken/overload_complicated_runme.ss | 2 +- .../test-suite/chicken/overload_copy_runme.ss | 2 +- .../chicken/overload_copy_runme_proxy.ss | 4 +- .../chicken/overload_extend_runme.ss | 2 +- .../chicken/overload_extend_runme_proxy.ss | 4 +- .../chicken/overload_simple_runme.ss | 2 +- .../chicken/overload_simple_runme_proxy.ss | 4 +- .../chicken/overload_subtype_runme.ss | 2 +- .../chicken/overload_subtype_runme_proxy.ss | 2 +- .../chicken/pointer_in_out_runme.ss | 2 +- .../chicken/reference_global_vars_runme.ss | 2 +- .../chicken/throw_exception_runme.ss | 2 +- .../chicken/typedef_inherit_runme.ss | 2 +- .../test-suite/chicken/typename_runme.ss | 2 +- .../test-suite/chicken/unions_runme.ss | 2 +- .../test-suite/chicken/unions_runme_proxy.ss | 2 + SWIG/Examples/test-suite/common.mk | 1 + SWIG/Examples/test-suite/cpp_basic.i | 52 ++ .../test-suite/guile/li_typemaps_runme.scm | 8 + SWIG/Examples/test-suite/li_typemaps.i | 11 + .../test-suite/schemerunme/global_vars.scm | 31 + .../schemerunme/global_vars_proxy.scm | 31 + .../test-suite/schemerunme/li_std_string.scm | 29 + .../test-suite/schemerunme/li_typemaps.scm | 34 ++ .../schemerunme/li_typemaps_proxy.scm | 34 ++ .../multiple_inheritance_proxy.scm | 15 + .../test-suite/schemerunme/unions_proxy.scm | 37 ++ SWIG/Lib/chicken/chicken.swg | 34 +- SWIG/Lib/chicken/chickenrun.swg | 26 +- SWIG/Lib/chicken/std_string.i | 36 +- SWIG/Lib/chicken/tinyclos-multi-generic.patch | 130 ++++- SWIG/Source/Modules/chicken.cxx | 532 ++++++++++-------- 72 files changed, 1085 insertions(+), 412 deletions(-) create mode 100644 SWIG/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/global_vars_runme.ss create mode 100644 SWIG/Examples/test-suite/chicken/global_vars_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/li_std_string_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/li_typemaps_runme.ss create mode 100644 SWIG/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/newobject1_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/chicken/unions_runme_proxy.ss create mode 100644 SWIG/Examples/test-suite/cpp_basic.i create mode 100644 SWIG/Examples/test-suite/guile/li_typemaps_runme.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/global_vars.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/global_vars_proxy.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/li_typemaps.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/li_typemaps_proxy.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/multiple_inheritance_proxy.scm create mode 100644 SWIG/Examples/test-suite/schemerunme/unions_proxy.scm diff --git a/SWIG/CHANGES.current b/SWIG/CHANGES.current index c38920a1c..c6de95744 100644 --- a/SWIG/CHANGES.current +++ b/SWIG/CHANGES.current @@ -1,6 +1,16 @@ Version 1.3.25 (In progress) ============================ +04/14/2005: wuzzeb (John Lenz) + [Chicken] + + Added a whole bunch of new _runme scripts into the chicken test + suite. Also fix some bugs these new scripts turned up. + + + Added optimization when returning a wrapped proxy class. Before, + a minor garbage collection was invoked every time a function returned. + + + All the chicken Examples should now run correctly + 04/14/2005: wsfulton [C#] More fixes for typemap matching when wrapping variables, in particular std::string, so that std::string variables can be easily marshalled with diff --git a/SWIG/Doc/Manual/Chicken.html b/SWIG/Doc/Manual/Chicken.html index 2aaab3a47..eb08c0883 100644 --- a/SWIG/Doc/Manual/Chicken.html +++ b/SWIG/Doc/Manual/Chicken.html @@ -26,11 +26,11 @@
  • Exceptions
  • TinyCLOS -
  • Compilation -
  • Linkage +
  • Linkage
  • Typemaps
  • Pointers @@ -205,7 +205,7 @@

    - In all cases, the constants may be accessed from with CHICKEN + In all cases, the constants may be accessed from within CHICKEN using the form (MYCONSTANT1); that is, the constants may be accessed using the read-only parameter form.

    @@ -247,7 +247,7 @@

    Chicken supports both the SWIG_exception(int code, const char *msg) interface as well as a SWIG_ThrowException(C_word val) function for throwing exceptions from - inside the %exception blocks. SWIG_exception will throw a list consiting of the code + inside the %exception blocks. SWIG_exception will throw a list consisting of the code (as an integer) and the message. Both of these will throw an exception using (abort), which can be handled by (handle-exceptions). See Chicken manual on Exceptions @@ -378,7 +378,7 @@ $ csc -v test_script.scm -lexample -

    An alternative is the test_script.scm can have the code (load-library 'example "example.so"), +

    An alternative is that the test_script.scm can have the code (load-library 'example "example.so"), in which case the test script does not need to be linked with example.so. The test_script.scm file can then be run with csi.

    @@ -388,8 +388,8 @@ be run with csi.

    Building a shared library like in the above section only works if the library is linked at compile time with a script containing (declare (uses ...)) or is -loaded explictetly with (load-library 'example "example.so"). It is -not the format that chicken expects for extension libraries and eggs. The problem is the +loaded explicitly with (load-library 'example "example.so"). It is +not the format that CHICKEN expects for extension libraries and eggs. The problem is the (declare (unit modname)) inside the modname.scm file. There are two possible solutions to this.

    @@ -405,7 +405,7 @@ $ csc -sv modname.scm modname_wrap.c modname_impl.c -o modname.so

    This library can then be loaded by scheme code with the (require 'modname) function. See -Loading-extension-libraries in the eval unit inside the Chicken manual for more information.

    +Loading-extension-libraries in the eval unit inside the CHICKEN manual for more information.

    Another alternative is to run SWIG normally and create a scheme file that contains (declare (uses modname)) and then compile that file into the shared library as well. For example, inside the mod_load.scm file,

    @@ -443,6 +443,7 @@ two eggs, one using the first method and one using the second method.

    17.4.3 Linking multiple SWIG modules with TinyCLOS

    +

    Linking together multiple modules that share type information using the %import directive while also using -proxy is more complicated. For example, if mod2.i imports mod1.i, then the mod2.scm file contains references to symbols declared in mod1.scm, diff --git a/SWIG/Examples/chicken/README b/SWIG/Examples/chicken/README index fb518ce02..6245f41e3 100644 --- a/SWIG/Examples/chicken/README +++ b/SWIG/Examples/chicken/README @@ -10,5 +10,3 @@ zlib -- a wrapping of the zlib compression library You should be able to run make in each of the examples. By default, a shared library will be built. Run make check to execute the test. - -You can uncomment a few lines in the Makefile to build a static test exe. diff --git a/SWIG/Examples/chicken/class/Makefile b/SWIG/Examples/chicken/class/Makefile index cf79b7ffa..1261ec5ac 100644 --- a/SWIG/Examples/chicken/class/Makefile +++ b/SWIG/Examples/chicken/class/Makefile @@ -7,7 +7,7 @@ TARGET = class INCLUDE = SWIGOPT = CFLAGS = -VARIANT = _csc +VARIANT = # uncomment the following lines to build a static exe (only pick one of the CHICKEN_MAIN lines) #CHICKEN_MAIN = test-lowlevel-class.scm diff --git a/SWIG/Examples/chicken/class/test-lowlevel-class.scm b/SWIG/Examples/chicken/class/test-lowlevel-class.scm index 820b3fc06..7c59c0aaa 100644 --- a/SWIG/Examples/chicken/class/test-lowlevel-class.scm +++ b/SWIG/Examples/chicken/class/test-lowlevel-class.scm @@ -64,8 +64,9 @@ (display "\nGuess I'll clean up now\n") ;; Note: this invokes the virtual destructor -(delete-Shape c) -(delete-Shape s) +(set! c #f) +(set! s #f) +(gc #t) (set! s 3) (display (Shape-nshapes)) diff --git a/SWIG/Examples/chicken/class/test-tinyclos-class.scm b/SWIG/Examples/chicken/class/test-tinyclos-class.scm index 45e241edb..809a39e6d 100644 --- a/SWIG/Examples/chicken/class/test-tinyclos-class.scm +++ b/SWIG/Examples/chicken/class/test-tinyclos-class.scm @@ -20,7 +20,7 @@ ;; ----- Access a static member ----- (display "\nA total of ") -(display (nshapes)) +(display (Shape-nshapes)) (display " shapes were created\n") ;; ----- Member data access ----- @@ -67,9 +67,9 @@ ;; Note: Invoke the virtual destructors by forcing garbage collection (set! c 77) (set! s 88) -;(gc #t) +(gc #t) -(display (nshapes)) +(display (Shape-nshapes)) (display " shapes remain\n") (display "Goodbye\n") diff --git a/SWIG/Examples/chicken/constants/test-constants.scm b/SWIG/Examples/chicken/constants/test-constants.scm index a5dcbd34f..1b10b2605 100644 --- a/SWIG/Examples/chicken/constants/test-constants.scm +++ b/SWIG/Examples/chicken/constants/test-constants.scm @@ -1,8 +1,6 @@ -;; run with './constants test-constants.scm' ;; feel free to uncomment and comment sections -(load-library 'example "constants.so") -(declare (uses example)) +(load-library 'example "./constants.so") (display "starting test ... you will see 'finished' if successful.\n") (or (= (ICONST) 42) (exit 1)) diff --git a/SWIG/Examples/chicken/multimap/test-multimap.scm b/SWIG/Examples/chicken/multimap/test-multimap.scm index 8080edd4a..0f5653fc5 100644 --- a/SWIG/Examples/chicken/multimap/test-multimap.scm +++ b/SWIG/Examples/chicken/multimap/test-multimap.scm @@ -2,7 +2,6 @@ ;; feel free to uncomment and comment sections (load-library 'example "multimap.so") -(declare (uses example)) (display "(gcd 90 12): ") (display (gcd 90 12)) diff --git a/SWIG/Examples/chicken/overload/test-overload.scm b/SWIG/Examples/chicken/overload/test-overload.scm index 16a7fc75e..168490f76 100644 --- a/SWIG/Examples/chicken/overload/test-overload.scm +++ b/SWIG/Examples/chicken/overload/test-overload.scm @@ -1,8 +1,6 @@ ;; This file demonstrates the overloading capabilities of SWIG (load-library 'example "overload.so") -(declare (uses example)) -(declare (uses tinyclos)) ;; Low level ;; --------- @@ -40,7 +38,7 @@ Trying TinyCLOS code ... (foo 1) (foo "some string") (define A-FOO (make )) -(define ANOTHER-FOO (make (slot-ref A-FOO 'swig-this))) ;; copy constructor +(define ANOTHER-FOO (make A-FOO)) ;; copy constructor (bar A-FOO 2) (bar ANOTHER-FOO "another string" 3) diff --git a/SWIG/Examples/chicken/simple/example.i b/SWIG/Examples/chicken/simple/example.i index 405fbc9d4..e18502c7c 100644 --- a/SWIG/Examples/chicken/simple/example.i +++ b/SWIG/Examples/chicken/simple/example.i @@ -8,6 +8,6 @@ extern double My_variable; extern int fact(int); -%name(mod) extern int my_mod(int n, int m); +%rename(mod) my_mod; extern int my_mod(int n, int m); extern char *get_time(); diff --git a/SWIG/Examples/chicken/simple/test-simple.scm b/SWIG/Examples/chicken/simple/test-simple.scm index 0fda90a90..05aa87081 100644 --- a/SWIG/Examples/chicken/simple/test-simple.scm +++ b/SWIG/Examples/chicken/simple/test-simple.scm @@ -1,6 +1,5 @@ ;; feel free to uncomment and comment sections (load-library 'example "simple.so") -(declare (uses example)) (display "(My-variable): ") (display (My-variable)) @@ -14,31 +13,14 @@ (display (My-variable)) (display "\n") -(display "(My-variable 'a): ") -;;(display (My-variable 'a)) -(display "\n") - -(display "(My-variable 1.5 'b): ") -(display (My-variable 1.5 'b)) -(display "\n") - (display "(fact 5): ") (display (fact 5)) (display "\n") -(display "(fact 'a): ") -;;(display (fact 'a)) -(display "\n") - (display "(mod 75 7): ") (display (mod 75 7)) (display "\n") -(display "(my-mod 75 7): ") -(display (my-mod 75 7)) -(display "\n") - - (display "(get-time): ") (display (get-time)) (display "\n") diff --git a/SWIG/Examples/chicken/zlib/Makefile b/SWIG/Examples/chicken/zlib/Makefile index b99be88ff..720701444 100644 --- a/SWIG/Examples/chicken/zlib/Makefile +++ b/SWIG/Examples/chicken/zlib/Makefile @@ -5,27 +5,24 @@ SRCS = CXXSRCS = TARGET = zlib INCLUDE = -SWIGOPT = -I/usr/include -mixed -prefix zlib +SWIGOPT = -I/usr/include CFLAGS = VARIANT = LIBS = -lz - -# comment out the following two lines to build a dynamic exe -CHICKEN_MAIN = test-zlib.scm -VARIANT = _static +VARIANT = _direct all:: $(TARGET) $(TARGET): $(INTERFACE) $(SRCS) $(MAKE) -f $(TOP)/Makefile \ - SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' CHICKEN_MAIN='$(CHICKEN_MAIN)' \ + SRCS='$(SRCS)' CXXSRCS='$(CXXSRCS)' \ INCLUDE='$(INCLUDE)' SWIGOPT='$(SWIGOPT)' LIBS='$(LIBS)' TARGET='$(TARGET)' \ SWIG='$(SWIG)' INTERFACE='$(INTERFACE)' CHICKENOPTS='$(CHICKENOPTS)' chicken$(VARIANT) clean:: $(MAKE) -f $(TOP)/Makefile chicken_clean - rm -f example.scm example-generic.scm example-clos.scm + rm -f example.scm rm -f $(TARGET) check:: - csi -batch simple.so test-zlib.scm + csi test-zlib.scm diff --git a/SWIG/Examples/chicken/zlib/test-zlib.scm b/SWIG/Examples/chicken/zlib/test-zlib.scm index ee538f6d0..b4b23dc5d 100644 --- a/SWIG/Examples/chicken/zlib/test-zlib.scm +++ b/SWIG/Examples/chicken/zlib/test-zlib.scm @@ -1,45 +1,43 @@ -;; run with './zlib test-zlib.scm' - -(declare (uses example)) -(declare (uses format)) +(load-library 'example "./zlib.so") ;; Init zstream -(define s (zlib:new-z-stream)) -(zlib:z-stream-zalloc-set s #f) -(zlib:z-stream-zfree-set s #f) -(zlib:z-stream-opaque-set s #f) -(zlib:deflate-init s (zlib:z-default-compression)) +(define s (new-z-stream)) +(z-stream-zalloc-set s #f) +(z-stream-zfree-set s #f) +(z-stream-opaque-set s #f) +(deflate-init s (Z-DEFAULT-COMPRESSION)) ;; Deflate something small so we don't need to loop/stream data (define in "some pony et jumping et jack et flash et had a jack pony") (define out (make-string 1000)) -(format #t "to be compressed: ~A~%to be compressed bytes: ~D~%~%" in (string-length in)) -(zlib:z-stream-next-in-set s in) -(zlib:z-stream-avail-in-set s (string-length in)) -(zlib:z-stream-next-out-set s out) -(zlib:z-stream-avail-out-set s (string-length out)) +(printf "to be compressed: ~A~%to be compressed bytes: ~A~%~%" in (string-length in)) +(z-stream-next-in-set s in) +(z-stream-avail-in-set s (string-length in)) +(z-stream-next-out-set s out) +(z-stream-avail-out-set s (string-length out)) (let* - ((saved-out (zlib:z-stream-save-next-out s)) - (ret (zlib:deflate s (zlib:z-finish)))) + ((saved-out (z-stream-save-next-out s)) + (ret (deflate s (Z-FINISH)))) (cond - ((= ret (zlib:z-stream-end)) - (format #t "deflated properly!~%compressed bytes: ~D~%compressed stream: ~S~%" - (zlib:z-stream-total-out-get s) (zlib:z-stream-get-next-chunk s saved-out))) - ((= ret (zlib:z-ok)) + ((= ret (Z-STREAM-END)) + (printf "deflated properly!~%compressed bytes: ~A~%compressed stream: ~A~%" + (z-stream-total-out-get s) (z-stream-get-next-chunk s saved-out))) + ((= ret (Z-OK)) (display "only partial deflation ... not enough output space\n")) (else - (format #t "deflate error(~D): ~A ~%" ret (zlib:z-stream-msg-get s))))) + (printf "deflate error(~D): ~A ~%" ret (z-stream-msg-get s))))) ;; Use simple compress routine, and set max output size to 100 -(define c (zlib:compress 100 in)) +(define c (compress 100 in)) (newline) (let ((ret (car c)) (compressed (cadr c))) (cond - ((= ret (zlib:z-ok)) - (format #t "compressed properly!~%compressed bytes: ~D~%compressed stream: ~S~%" + ((= ret (Z-OK)) + (printf "compressed properly!~%compressed bytes: ~A~%compressed stream: ~A~%" (string-length compressed) compressed)) (else - (format #t "compress error(~D): ~A ~%" ret (zlib:z-error ret))))) + (printf "compress error(~D): ~A ~%" ret (z-error ret))))) +(exit 0) diff --git a/SWIG/Examples/test-suite/chicken/Makefile.in b/SWIG/Examples/test-suite/chicken/Makefile.in index 351ba386b..fb55c8f56 100644 --- a/SWIG/Examples/test-suite/chicken/Makefile.in +++ b/SWIG/Examples/test-suite/chicken/Makefile.in @@ -18,7 +18,7 @@ SO = @SO@ include $(srcdir)/../common.mk # Overridden variables here -SWIGOPT += +SWIGOPT += -nounit # Rules for the different types of tests %.cpptest: @@ -41,6 +41,9 @@ SWIGOPT += $(setup) \ ($(swig_and_compile_multi_cpp); ) && \ $(run_testcase) + if [ -f $(srcdir)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then ( \ + $(MAKE) $*.multiproxy; ) \ + fi; # Runs the testcase. A testcase is only run if # a file is found which has _runme.scm appended after the testcase name. @@ -65,6 +68,13 @@ run_testcase = \ ($(swig_and_compile_c); ) && \ $(run_testcase) +%.multiproxy: SWIGOPT += -proxy -noclosuses +%.multiproxy: SCRIPTSUFFIX = $(PROXYSUFFIX) +%.multiproxy: + echo "Checking testcase $* (with run test) under chicken with -proxy"; \ + ($(swig_and_compile_multi_cpp); ) && \ + $(run_testcase) + # Clean %.clean: diff --git a/SWIG/Examples/test-suite/chicken/casts_runme.ss b/SWIG/Examples/test-suite/chicken/casts_runme.ss index 129f42efb..2eca46149 100644 --- a/SWIG/Examples/test-suite/chicken/casts_runme.ss +++ b/SWIG/Examples/test-suite/chicken/casts_runme.ss @@ -1,2 +1,2 @@ -(load-library 'casts "casts.so") +(load "casts.so") (include "../schemerunme/casts.scm") diff --git a/SWIG/Examples/test-suite/chicken/char_constant_runme.ss b/SWIG/Examples/test-suite/chicken/char_constant_runme.ss index 4b5db6a8d..50dff3018 100644 --- a/SWIG/Examples/test-suite/chicken/char_constant_runme.ss +++ b/SWIG/Examples/test-suite/chicken/char_constant_runme.ss @@ -1,2 +1,2 @@ -(load-library 'char_constant "char_constant.so") +(load "char_constant.so") (include "../schemerunme/char_constant.scm") diff --git a/SWIG/Examples/test-suite/chicken/class_ignore_runme.ss b/SWIG/Examples/test-suite/chicken/class_ignore_runme.ss index f9d52c9fc..ba84810a3 100644 --- a/SWIG/Examples/test-suite/chicken/class_ignore_runme.ss +++ b/SWIG/Examples/test-suite/chicken/class_ignore_runme.ss @@ -1,2 +1,2 @@ -(load-library 'class_ignore "class_ignore.so") +(load "class_ignore.so") (include "../schemerunme/class_ignore.scm") diff --git a/SWIG/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss new file mode 100644 index 000000000..62f2c2053 --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/clientdata_prop_runme_proxy.ss @@ -0,0 +1,95 @@ +(require 'clientdata_prop_a) +(require 'clientdata_prop_b) + +(define a (make )) +(test-A a) +(test-tA a) +(test-t2A a) +(test-t3A a) +(fA a) + +(define b (make )) +(test-A b) +(test-tA b) +(test-t2A b) +(test-t3A b) +(test-B b) +(fA b) +(fB b) + +(define c (make )) +(test-A c) +(test-tA c) +(test-t2A c) +(test-t3A c) +(test-C c) +(fA c) +(fC c) + +(define d (make )) +(test-A d) +(test-tA d) +(test-t2A d) +(test-t3A d) +(test-D d) +(test-tD d) +(test-t2D d) +(fA d) +(fD d) + +;; here are the real tests... if the clientdata is correctly +;; propegated, new-tA, new-t2A, should all return wrapped proxy's +;; of class + +(define a2 (new-tA)) +(if (not (eq? (class-of a2) )) + (error "Error 1")) +(test-A a2) +(test-tA a2) +(test-t2A a2) +(test-t3A a2) +(fA a2) + +(define a3 (new-t2A)) +(if (not (eq? (class-of a3) )) + (error "Error 2")) +(test-A a3) +(test-tA a3) +(test-t2A a3) +(test-t3A a3) +(fA a3) + +(define a4 (new-t3A)) +(if (not (eq? (class-of a4) )) + (error "Error 3")) +(test-A a4) +(test-tA a4) +(test-t2A a4) +(test-t3A a4) +(fA a4) + +(define d2 (new-tD)) +(if (not (eq? (class-of d2) )) + (error "Error 4")) +(test-A d2) +(test-tA d2) +(test-t2A d2) +(test-t3A d2) +(test-D d2) +(test-tD d2) +(fA d2) +(fD d2) + +(define d3 (new-t2D)) +(if (not (eq? (class-of d3) )) + (error "Error 5")) +(test-A d3) +(test-tA d3) +(test-t2A d3) +(test-t3A d3) +(test-D d3) +(test-tD d3) +(fA d3) +(fD d3) + +(exit 0) diff --git a/SWIG/Examples/test-suite/chicken/constover_runme.ss b/SWIG/Examples/test-suite/chicken/constover_runme.ss index 5d5e650c5..eb39c7ff0 100644 --- a/SWIG/Examples/test-suite/chicken/constover_runme.ss +++ b/SWIG/Examples/test-suite/chicken/constover_runme.ss @@ -1,2 +1,2 @@ -(load-library 'constover "constover.so") +(load "constover.so") (include "../schemerunme/constover.scm") diff --git a/SWIG/Examples/test-suite/chicken/contract_runme.ss b/SWIG/Examples/test-suite/chicken/contract_runme.ss index ad8d97211..006bcfdec 100644 --- a/SWIG/Examples/test-suite/chicken/contract_runme.ss +++ b/SWIG/Examples/test-suite/chicken/contract_runme.ss @@ -1,3 +1,3 @@ -(load-library 'contract "contract.so") +(load "contract.so") (include "testsuite.ss") (include "../schemerunme/contract.scm") diff --git a/SWIG/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss new file mode 100644 index 000000000..f343906e6 --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/cpp_basic_runme_proxy.ss @@ -0,0 +1,51 @@ +(require 'cpp_basic) + +(define-macro (check test) + `(if (not ,test) (error "Error in test " ',test))) + +(define f (make 4)) +(check (= (slot-ref f 'num) 4)) +(slot-set! f 'num -17) +(check (= (slot-ref f 'num) -17)) + +(define b (make )) + +(slot-set! b 'fptr f) +(check (= (slot-ref (slot-ref b 'fptr) 'num) -17)) +(check (= (test b -3 (slot-ref b 'fptr)) -5)) +(slot-set! f 'num 12) +(check (= (slot-ref (slot-ref b 'fptr) 'num) 12)) + +(check (= (slot-ref (slot-ref b 'fref) 'num) -4)) +(check (= (test b 12 (slot-ref b 'fref)) 23)) +;; references don't take ownership, so if we didn't define this here it might get garbage collected +(define f2 (make 23)) +(slot-set! b 'fref f2) +(check (= (slot-ref (slot-ref b 'fref) 'num) 23)) +(check (= (test b -3 (slot-ref b 'fref)) 35)) + +(check (= (slot-ref (slot-ref b 'fval) 'num) 15)) +(check (= (test b 3 (slot-ref b 'fval)) 33)) +(slot-set! b 'fval (make -15)) +(check (= (slot-ref (slot-ref b 'fval) 'num) -15)) +(check (= (test b 3 (slot-ref b 'fval)) -27)) + +(define f3 (testFoo b 12 (slot-ref b 'fref))) +(check (= (slot-ref f3 'num) 32)) + +;; now test global +(define f4 (make 6)) +(Bar-global-fptr f4) +(check (= (slot-ref (Bar-global-fptr) 'num) 6)) +(slot-set! f4 'num 8) +(check (= (slot-ref (Bar-global-fptr) 'num) 8)) + +(check (= (slot-ref (Bar-global-fref) 'num) 23)) +(Bar-global-fref (make -7)) +(check (= (slot-ref (Bar-global-fref) 'num) -7)) + +(check (= (slot-ref (Bar-global-fval) 'num) 3)) +(Bar-global-fval (make -34)) +(check (= (slot-ref (Bar-global-fval) 'num) -34)) + +(exit 0) diff --git a/SWIG/Examples/test-suite/chicken/cpp_enum_runme.ss b/SWIG/Examples/test-suite/chicken/cpp_enum_runme.ss index c1c531462..4d4ec7623 100644 --- a/SWIG/Examples/test-suite/chicken/cpp_enum_runme.ss +++ b/SWIG/Examples/test-suite/chicken/cpp_enum_runme.ss @@ -1,2 +1,2 @@ -(load-library 'cpp-enum "cpp_enum.so") +(load "cpp_enum.so") (include "../schemerunme/cpp_enum.scm") diff --git a/SWIG/Examples/test-suite/chicken/cpp_namespace_runme.ss b/SWIG/Examples/test-suite/chicken/cpp_namespace_runme.ss index f677553ad..800172ed8 100644 --- a/SWIG/Examples/test-suite/chicken/cpp_namespace_runme.ss +++ b/SWIG/Examples/test-suite/chicken/cpp_namespace_runme.ss @@ -1,2 +1,2 @@ -(load-library 'cpp_namespace "cpp_namespace.so") +(load "cpp_namespace.so") (include "../schemerunme/cpp_namespace.scm") diff --git a/SWIG/Examples/test-suite/chicken/dynamic_cast_runme.ss b/SWIG/Examples/test-suite/chicken/dynamic_cast_runme.ss index 6c86f57c1..1e81d5555 100644 --- a/SWIG/Examples/test-suite/chicken/dynamic_cast_runme.ss +++ b/SWIG/Examples/test-suite/chicken/dynamic_cast_runme.ss @@ -1,2 +1,2 @@ -(load-library 'dynamic_cast "dynamic_cast.so") +(load "dynamic_cast.so") (include "../schemerunme/dynamic_cast.scm") diff --git a/SWIG/Examples/test-suite/chicken/global_vars_runme.ss b/SWIG/Examples/test-suite/chicken/global_vars_runme.ss new file mode 100644 index 000000000..802205b7c --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/global_vars_runme.ss @@ -0,0 +1,2 @@ +(require 'global_vars) +(load "../schemerunme/global_vars.scm") diff --git a/SWIG/Examples/test-suite/chicken/global_vars_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/global_vars_runme_proxy.ss new file mode 100644 index 000000000..3c4500d6b --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/global_vars_runme_proxy.ss @@ -0,0 +1,2 @@ +(require 'global_vars) +(load "../schemerunme/global_vars_proxy.scm") diff --git a/SWIG/Examples/test-suite/chicken/import_nomodule_runme.ss b/SWIG/Examples/test-suite/chicken/import_nomodule_runme.ss index e2e2c4a26..7e64053bc 100644 --- a/SWIG/Examples/test-suite/chicken/import_nomodule_runme.ss +++ b/SWIG/Examples/test-suite/chicken/import_nomodule_runme.ss @@ -1,2 +1,2 @@ -(load-library 'import_nomodule "import_nomodule.so") +(load "import_nomodule.so") (include "../schemerunme/import_nomodule.scm") diff --git a/SWIG/Examples/test-suite/chicken/imports_runme.ss b/SWIG/Examples/test-suite/chicken/imports_runme.ss index a11190844..ac5fb9890 100644 --- a/SWIG/Examples/test-suite/chicken/imports_runme.ss +++ b/SWIG/Examples/test-suite/chicken/imports_runme.ss @@ -1,3 +1,3 @@ -(load-library 'imports_a "imports_a.so") -(load-library 'imports_b "imports_b.so") +(load "imports_a.so") +(load "imports_b.so") (include "../schemerunme/imports.scm") diff --git a/SWIG/Examples/test-suite/chicken/inherit_missing_runme.ss b/SWIG/Examples/test-suite/chicken/inherit_missing_runme.ss index 7de928496..50a084a95 100644 --- a/SWIG/Examples/test-suite/chicken/inherit_missing_runme.ss +++ b/SWIG/Examples/test-suite/chicken/inherit_missing_runme.ss @@ -1,2 +1,2 @@ -(load-library 'inherit_missing "inherit_missing.so") +(load "inherit_missing.so") (include "../schemerunme/inherit_missing.scm") diff --git a/SWIG/Examples/test-suite/chicken/li_std_string_runme.ss b/SWIG/Examples/test-suite/chicken/li_std_string_runme.ss index 1feec38ee..cc64287dd 100644 --- a/SWIG/Examples/test-suite/chicken/li_std_string_runme.ss +++ b/SWIG/Examples/test-suite/chicken/li_std_string_runme.ss @@ -1,2 +1,2 @@ -(load-library 'li-std-string "li_std_string.so") +(load "li_std_string.so") (include "../schemerunme/li_std_string.scm") diff --git a/SWIG/Examples/test-suite/chicken/li_std_string_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/li_std_string_runme_proxy.ss new file mode 100644 index 000000000..c78b679e1 --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/li_std_string_runme_proxy.ss @@ -0,0 +1,48 @@ +(load "li_std_string.so") + +(define x "hello") + +(if (not (string=? (test-value x) x)) + (begin (error "Error 1") (exit 1))) + +(if (not (string=? (test-const-reference x) x)) + (begin (error "Error 2") (exit 1))) + +(define y (test-pointer-out)) +(test-pointer y) +(define z (test-const-pointer-out)) +(test-const-pointer z) + +(define a (test-reference-out)) +(test-reference a) + +;; test global variables +(GlobalString "whee") +(if (not (string=? (GlobalString) "whee")) + (error "Error 3")) +(if (not (string=? (GlobalString2) "global string 2")) + (error "Error 4")) + +(define struct (make )) + +;; MemberString should be a wrapped class +(define scl (slot-ref struct 'MemberString)) +(if (not (string=? (slot-ref scl 'str) "")) + (error "Error 4.5")) +(slot-set! scl 'str "and how") +(if (not (string=? (slot-ref (slot-ref struct 'MemberString) 'str) "and how")) + (error "Error 5")) +(if (not (string=? (slot-ref struct 'MemberString2) "member string 2")) + (error "Error 6")) +(Structure-StaticMemberString "static str") +(if (not (string=? (Structure-StaticMemberString) "static str")) + (error "Error 7")) +(if (not (string=? (Structure-StaticMemberString2) "static member string 2")) + (error "Error 8")) + +;(if (not (string=? (Structure-ConstMemberString-get struct) "const member string")) +; (error "Error 9")) +(if (not (string=? (Structure-ConstStaticMemberString) "const static member string")) + (error "Error 10")) + +(exit 0) diff --git a/SWIG/Examples/test-suite/chicken/li_typemaps_runme.ss b/SWIG/Examples/test-suite/chicken/li_typemaps_runme.ss new file mode 100644 index 000000000..6e845ec55 --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/li_typemaps_runme.ss @@ -0,0 +1,2 @@ +(require 'li_typemaps) +(load "../schemerunme/li_typemaps.scm") diff --git a/SWIG/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss new file mode 100644 index 000000000..53340c38e --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/li_typemaps_runme_proxy.ss @@ -0,0 +1,2 @@ +(require 'li_typemaps) +(load "../schemerunme/li_typemaps_proxy.scm") diff --git a/SWIG/Examples/test-suite/chicken/list_vector_runme.ss b/SWIG/Examples/test-suite/chicken/list_vector_runme.ss index c977eac6b..67d52f609 100644 --- a/SWIG/Examples/test-suite/chicken/list_vector_runme.ss +++ b/SWIG/Examples/test-suite/chicken/list_vector_runme.ss @@ -1,2 +1,2 @@ -(load-library 'list_vector "list_vector.so") +(load "list_vector.so") (include "../schemerunme/list_vector.scm") diff --git a/SWIG/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss new file mode 100644 index 000000000..313157c70 --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/multiple_inheritance_runme_proxy.ss @@ -0,0 +1,2 @@ +(require 'multiple_inheritance) +(load "../schemerunme/multiple_inheritance_proxy.scm") diff --git a/SWIG/Examples/test-suite/chicken/multivalue_runme.ss b/SWIG/Examples/test-suite/chicken/multivalue_runme.ss index 135e6a8ab..f5aafcbf4 100644 --- a/SWIG/Examples/test-suite/chicken/multivalue_runme.ss +++ b/SWIG/Examples/test-suite/chicken/multivalue_runme.ss @@ -1,4 +1,4 @@ ;; this doesn't work yet :( -(load-library 'multivalue "multivalue.so") +(load "multivalue.so") (include "../schemerunme/multivalue.scm") (exit 0) diff --git a/SWIG/Examples/test-suite/chicken/name_runme.ss b/SWIG/Examples/test-suite/chicken/name_runme.ss index 47a6c5933..938915dcb 100644 --- a/SWIG/Examples/test-suite/chicken/name_runme.ss +++ b/SWIG/Examples/test-suite/chicken/name_runme.ss @@ -1,2 +1,2 @@ -(load-library 'name "name.so") +(load "name.so") (include "../schemerunme/name.scm") diff --git a/SWIG/Examples/test-suite/chicken/newobject1_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/newobject1_runme_proxy.ss new file mode 100644 index 000000000..7bc5a241a --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/newobject1_runme_proxy.ss @@ -0,0 +1,30 @@ +(require 'newobject1) + +(define-macro (check-count val) + `(if (not (= (Foo-fooCount) ,val)) (error "Error checking val " ,val " != " ,(Foo-fooCount)))) + +(define f (Foo-makeFoo)) + +(check-count 1) + +(define f2 (makeMore f)) + +(check-count 2) + +(set! f #f) +(gc #t) + +(check-count 1) + +(define f3 (makeMore f2)) + +(check-count 2) + +(set! f3 #f) +(set! f2 #f) + +(gc #t) + +(check-count 0) + +(exit 0) diff --git a/SWIG/Examples/test-suite/chicken/newobject2_runme.ss b/SWIG/Examples/test-suite/chicken/newobject2_runme.ss index b73446a47..cc445f477 100644 --- a/SWIG/Examples/test-suite/chicken/newobject2_runme.ss +++ b/SWIG/Examples/test-suite/chicken/newobject2_runme.ss @@ -1,4 +1,4 @@ -(load-library 'newobject2 "newobject2.so") +(load "newobject2.so") (define f (new-Foo)) diff --git a/SWIG/Examples/test-suite/chicken/newobject2_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/newobject2_runme_proxy.ss index 42bc300f3..36b8cda7f 100644 --- a/SWIG/Examples/test-suite/chicken/newobject2_runme_proxy.ss +++ b/SWIG/Examples/test-suite/chicken/newobject2_runme_proxy.ss @@ -1,4 +1,4 @@ -(load-library 'newobject2 "newobject2.so") +(load "newobject2.so") (define f (make )) diff --git a/SWIG/Examples/test-suite/chicken/overload_complicated_runme.ss b/SWIG/Examples/test-suite/chicken/overload_complicated_runme.ss index e42090986..f89f70bde 100644 --- a/SWIG/Examples/test-suite/chicken/overload_complicated_runme.ss +++ b/SWIG/Examples/test-suite/chicken/overload_complicated_runme.ss @@ -1,2 +1,2 @@ -(load-library 'overload_complicated "overload_complicated.so") +(load "overload_complicated.so") (include "../schemerunme/overload_complicated.scm") diff --git a/SWIG/Examples/test-suite/chicken/overload_copy_runme.ss b/SWIG/Examples/test-suite/chicken/overload_copy_runme.ss index 1ba8f7ea6..4ec542205 100644 --- a/SWIG/Examples/test-suite/chicken/overload_copy_runme.ss +++ b/SWIG/Examples/test-suite/chicken/overload_copy_runme.ss @@ -1,2 +1,2 @@ -(load-library 'overload_copy "overload_copy.so") +(load "overload_copy.so") (include "../schemerunme/overload_copy.scm") diff --git a/SWIG/Examples/test-suite/chicken/overload_copy_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/overload_copy_runme_proxy.ss index ec4ddd201..5f4808070 100644 --- a/SWIG/Examples/test-suite/chicken/overload_copy_runme_proxy.ss +++ b/SWIG/Examples/test-suite/chicken/overload_copy_runme_proxy.ss @@ -1,6 +1,4 @@ -(require 'tinyclos) -(load "../../../Lib/chicken/multi-generic.scm") -(load-library 'overload-copy "./overload_copy.so") +(load "./overload_copy.so") (define f (make )) (define g (make f)) diff --git a/SWIG/Examples/test-suite/chicken/overload_extend_runme.ss b/SWIG/Examples/test-suite/chicken/overload_extend_runme.ss index 57917c16a..a19cb29a9 100644 --- a/SWIG/Examples/test-suite/chicken/overload_extend_runme.ss +++ b/SWIG/Examples/test-suite/chicken/overload_extend_runme.ss @@ -1,2 +1,2 @@ -(load-library 'overload_extend "overload_extend.so") +(load "overload_extend.so") (include "../schemerunme/overload_extend.scm") diff --git a/SWIG/Examples/test-suite/chicken/overload_extend_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/overload_extend_runme_proxy.ss index 04c186a1d..2a6867e22 100644 --- a/SWIG/Examples/test-suite/chicken/overload_extend_runme_proxy.ss +++ b/SWIG/Examples/test-suite/chicken/overload_extend_runme_proxy.ss @@ -1,6 +1,4 @@ -(require 'tinyclos) -(load "../../../Lib/chicken/multi-generic.scm") -(load-library 'overload-extend "./overload_extend.so") +(load "./overload_extend.so") (define f (make )) diff --git a/SWIG/Examples/test-suite/chicken/overload_simple_runme.ss b/SWIG/Examples/test-suite/chicken/overload_simple_runme.ss index 61fbd35ea..24fa67aec 100644 --- a/SWIG/Examples/test-suite/chicken/overload_simple_runme.ss +++ b/SWIG/Examples/test-suite/chicken/overload_simple_runme.ss @@ -1,2 +1,2 @@ -(load-library 'overload_simple "overload_simple.so") +(load "overload_simple.so") (include "../schemerunme/overload_simple.scm") diff --git a/SWIG/Examples/test-suite/chicken/overload_simple_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/overload_simple_runme_proxy.ss index fa58f267e..0ae3e6215 100644 --- a/SWIG/Examples/test-suite/chicken/overload_simple_runme_proxy.ss +++ b/SWIG/Examples/test-suite/chicken/overload_simple_runme_proxy.ss @@ -1,6 +1,4 @@ -(require 'tinyclos) -(load "../../../Lib/chicken/multi-generic.scm") -(load-library 'overload_simple "overload_simple.so") +(load "overload_simple.so") (define-macro (check test) `(if (not ,test) (error ',test))) diff --git a/SWIG/Examples/test-suite/chicken/overload_subtype_runme.ss b/SWIG/Examples/test-suite/chicken/overload_subtype_runme.ss index 6ce2e0410..b3663b719 100644 --- a/SWIG/Examples/test-suite/chicken/overload_subtype_runme.ss +++ b/SWIG/Examples/test-suite/chicken/overload_subtype_runme.ss @@ -1,2 +1,2 @@ -(load-library 'overload_subtype "overload_subtype.so") +(load "overload_subtype.so") (include "../schemerunme/overload_subtype.scm") diff --git a/SWIG/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss index 74fb7de3f..d83d59a11 100644 --- a/SWIG/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss +++ b/SWIG/Examples/test-suite/chicken/overload_subtype_runme_proxy.ss @@ -1,4 +1,4 @@ -(load-library 'overload-subtype "./overload_subtype.so") +(load "./overload_subtype.so") (define f (make )) (define b (make )) diff --git a/SWIG/Examples/test-suite/chicken/pointer_in_out_runme.ss b/SWIG/Examples/test-suite/chicken/pointer_in_out_runme.ss index 7ed2ce9c2..807c4ebad 100644 --- a/SWIG/Examples/test-suite/chicken/pointer_in_out_runme.ss +++ b/SWIG/Examples/test-suite/chicken/pointer_in_out_runme.ss @@ -1,2 +1,2 @@ -(load-library 'pointer_in_out "pointer_in_out.so") +(load "pointer_in_out.so") (include "../schemerunme/pointer_in_out.scm") diff --git a/SWIG/Examples/test-suite/chicken/reference_global_vars_runme.ss b/SWIG/Examples/test-suite/chicken/reference_global_vars_runme.ss index 462e3007f..1e1914be3 100644 --- a/SWIG/Examples/test-suite/chicken/reference_global_vars_runme.ss +++ b/SWIG/Examples/test-suite/chicken/reference_global_vars_runme.ss @@ -1,2 +1,2 @@ -(load-library 'reference_global_vars "reference_global_vars.so") +(load "reference_global_vars.so") (include "../schemerunme/reference_global_vars.scm") diff --git a/SWIG/Examples/test-suite/chicken/throw_exception_runme.ss b/SWIG/Examples/test-suite/chicken/throw_exception_runme.ss index b92894424..3f0ec4b41 100644 --- a/SWIG/Examples/test-suite/chicken/throw_exception_runme.ss +++ b/SWIG/Examples/test-suite/chicken/throw_exception_runme.ss @@ -1,4 +1,4 @@ -(load-library 'throw-exception "throw_exception.so") +(load "throw_exception.so") (define-macro (check-throw expr check) `(if (handle-exceptions exvar (if ,check #f (begin (print "Error executing: " ',expr " " exvar) (exit 1))) ,expr #t) diff --git a/SWIG/Examples/test-suite/chicken/typedef_inherit_runme.ss b/SWIG/Examples/test-suite/chicken/typedef_inherit_runme.ss index 6686c3e5a..111296d60 100644 --- a/SWIG/Examples/test-suite/chicken/typedef_inherit_runme.ss +++ b/SWIG/Examples/test-suite/chicken/typedef_inherit_runme.ss @@ -1,2 +1,2 @@ -(load-library 'typedef_inherit "typedef_inherit.so") +(load "typedef_inherit.so") (include "../schemerunme/typedef_inherit.scm") diff --git a/SWIG/Examples/test-suite/chicken/typename_runme.ss b/SWIG/Examples/test-suite/chicken/typename_runme.ss index e9350017c..60fc3203b 100644 --- a/SWIG/Examples/test-suite/chicken/typename_runme.ss +++ b/SWIG/Examples/test-suite/chicken/typename_runme.ss @@ -1,2 +1,2 @@ -(load-library 'typename "typename.so") +(load "typename.so") (include "../schemerunme/typename.scm") diff --git a/SWIG/Examples/test-suite/chicken/unions_runme.ss b/SWIG/Examples/test-suite/chicken/unions_runme.ss index 31dc9ae6a..465784a43 100644 --- a/SWIG/Examples/test-suite/chicken/unions_runme.ss +++ b/SWIG/Examples/test-suite/chicken/unions_runme.ss @@ -1,2 +1,2 @@ -(load-library 'unions "unions.so") +(load "unions.so") (include "../schemerunme/unions.scm") diff --git a/SWIG/Examples/test-suite/chicken/unions_runme_proxy.ss b/SWIG/Examples/test-suite/chicken/unions_runme_proxy.ss new file mode 100644 index 000000000..4dd14148d --- /dev/null +++ b/SWIG/Examples/test-suite/chicken/unions_runme_proxy.ss @@ -0,0 +1,2 @@ +(load "unions.so") +(include "../schemerunme/unions_proxy.scm") diff --git a/SWIG/Examples/test-suite/common.mk b/SWIG/Examples/test-suite/common.mk index b9e9e3af4..0cf3b5795 100644 --- a/SWIG/Examples/test-suite/common.mk +++ b/SWIG/Examples/test-suite/common.mk @@ -96,6 +96,7 @@ CPP_TEST_CASES += \ conversion_namespace \ conversion_ns_template \ cplusplus_throw \ + cpp_basic \ cpp_enum \ cpp_namespace \ cpp_nodefault \ diff --git a/SWIG/Examples/test-suite/cpp_basic.i b/SWIG/Examples/test-suite/cpp_basic.i new file mode 100644 index 000000000..e86e4d4dc --- /dev/null +++ b/SWIG/Examples/test-suite/cpp_basic.i @@ -0,0 +1,52 @@ +/* This is a basic test of proxy classes, used by chicken */ + +%module cpp_basic + +%newobject Bar::testFoo; + +%inline %{ + +class Foo { + public: + Foo(int a) : num(a) {} + int num; +}; + +%} + +%{ +static Foo init_ref = Foo(-4); +%} + +%inline %{ +class Bar { + public: + Bar() : fptr(0), fref(init_ref), fval(15) , cint(3) {} + + Foo *fptr; + Foo &fref; + Foo fval; + + const int cint; + static const int global_cint = -4; + + static Foo *global_fptr; + static Foo &global_fref; + static Foo global_fval; + + int test(int a, Foo *f) { + return a + (f ? f->num : 0) + fval.num; + } + + Foo *testFoo(int a, Foo *f) { + return new Foo(2 * a + (f ? f->num : 0) + fval.num); + } +}; + +%} + +%{ +Foo *Bar::global_fptr = NULL; +Foo &Bar::global_fref = init_ref; +Foo Bar::global_fval = Foo(3); +%} diff --git a/SWIG/Examples/test-suite/guile/li_typemaps_runme.scm b/SWIG/Examples/test-suite/guile/li_typemaps_runme.scm new file mode 100644 index 000000000..39bc65ab3 --- /dev/null +++ b/SWIG/Examples/test-suite/guile/li_typemaps_runme.scm @@ -0,0 +1,8 @@ +;;; This is the union runtime testcase. It ensures that values within a +;;; union embedded within a struct can be set and read correctly. + +;; The SWIG modules have "passive" Linkage, i.e., they don't generate +;; 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_li_typemaps_module" (dynamic-link "./libli_typemaps.so")) +(load "../schemerunme/li_typemaps.scm") diff --git a/SWIG/Examples/test-suite/li_typemaps.i b/SWIG/Examples/test-suite/li_typemaps.i index d3098471d..a53c1c74a 100644 --- a/SWIG/Examples/test-suite/li_typemaps.i +++ b/SWIG/Examples/test-suite/li_typemaps.i @@ -3,8 +3,11 @@ %include "typemaps.i" %apply int &INOUT { int &INOUT2 }; +%newobject out_foo; %inline %{ +struct Foo { int a; }; + bool in_bool(bool *INPUT) { return *INPUT; } int in_int(int *INPUT) { return *INPUT; } long in_long(long *INPUT) { return *INPUT; } @@ -47,6 +50,14 @@ void out_double(double x, double *OUTPUT) { *OUTPUT = x; } void out_longlong(long long x, long long *OUTPUT) { *OUTPUT = x; } void out_ulonglong(unsigned long long x, unsigned long long *OUTPUT) { *OUTPUT = x; } +/* Tests a returning a wrapped pointer and an output argument */ +struct Foo *out_foo(int a, int *OUTPUT) { + struct Foo *f = new struct Foo(); + f->a = a; + *OUTPUT = a * 2; + return f; +} + void outr_bool(bool x, bool &OUTPUT) { OUTPUT = x; } void outr_int(int x, int &OUTPUT) { OUTPUT = x; } void outr_short(short x, short &OUTPUT) { OUTPUT = x; } diff --git a/SWIG/Examples/test-suite/schemerunme/global_vars.scm b/SWIG/Examples/test-suite/schemerunme/global_vars.scm new file mode 100644 index 000000000..a3e021952 --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/global_vars.scm @@ -0,0 +1,31 @@ +(define-macro (check test) + `(if (not ,test) (error "Error in test" ',test))) + +(b "hello") +(check (string=? (b) "hello")) + +(define sa (new-A)) +(A-x-set sa 5) +(a sa) +(check (= (A-x-get (a)) 5)) + +(ap sa) +(check (= (A-x-get (ap)) 5)) +(A-x-set sa 10) +(check (= (A-x-get (ap)) 10)) + +(define sa2 (new-A)) +(A-x-set sa2 -4) +(cap sa2) +(check (= (A-x-get (cap)) -4)) +(A-x-set sa2 -7) +(check (= (A-x-get (cap)) -7)) + +(check (= (A-x-get (ar)) 5)) +(ar sa2) +(check (= (A-x-get (ar)) -7)) + +(x 4) +(check (= (x) 4)) + +(exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/global_vars_proxy.scm b/SWIG/Examples/test-suite/schemerunme/global_vars_proxy.scm new file mode 100644 index 000000000..41d73379b --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/global_vars_proxy.scm @@ -0,0 +1,31 @@ +(define-macro (check test) + `(if (not ,test) (error "Error in test" ',test))) + +(b "hello") +(check (string=? (b) "hello")) + +(define sa (make )) +(slot-set! sa 'x 5) +(a sa) +(check (= (slot-ref (a) 'x) 5)) + +(ap sa) +(check (= (slot-ref (ap) 'x) 5)) +(slot-set! sa 'x 10) +(check (= (slot-ref (ap) 'x) 10)) + +(define sa2 (make )) +(slot-set! sa2 'x -4) +(cap sa2) +(check (= (slot-ref (cap) 'x) -4)) +(slot-set! sa2 'x -7) +(check (= (slot-ref (cap) 'x) -7)) + +(check (= (slot-ref (ar) 'x) 5)) +(ar sa2) +(check (= (slot-ref (ar) 'x) -7)) + +(x 4) +(check (= (x) 4)) + +(exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/li_std_string.scm b/SWIG/Examples/test-suite/schemerunme/li_std_string.scm index 933bc91a7..b2ac6c7e8 100644 --- a/SWIG/Examples/test-suite/schemerunme/li_std_string.scm +++ b/SWIG/Examples/test-suite/schemerunme/li_std_string.scm @@ -14,4 +14,33 @@ (define a (test-reference-out)) (test-reference a) +;; test global variables +(GlobalString "whee") +(if (not (string=? (GlobalString) "whee")) + (error "Error 3")) +(if (not (string=? (GlobalString2) "global string 2")) + (error "Error 4")) + +(define struct (new-Structure)) + +;; MemberString should be a wrapped class +(define scl (Structure-MemberString-get struct)) +(if (not (string=? (std-string-str-get scl) "")) + (error "Error 4.5")) +(std-string-str-set scl "and how") +(if (not (string=? (std-string-str-get (Structure-MemberString-get struct)) "and how")) + (error "Error 5")) +(if (not (string=? (Structure-MemberString2-get struct) "member string 2")) + (error "Error 6")) +(Structure-StaticMemberString "static str") +(if (not (string=? (Structure-StaticMemberString) "static str")) + (error "Error 7")) +(if (not (string=? (Structure-StaticMemberString2) "static member string 2")) + (error "Error 8")) + +;(if (not (string=? (Structure-ConstMemberString-get struct) "const member string")) +; (error "Error 9")) +(if (not (string=? (Structure-ConstStaticMemberString) "const static member string")) + (error "Error 10")) + (exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/li_typemaps.scm b/SWIG/Examples/test-suite/schemerunme/li_typemaps.scm new file mode 100644 index 000000000..2761dedc1 --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/li_typemaps.scm @@ -0,0 +1,34 @@ +(define-macro (check func val test) + (cons 'begin + (map + (lambda (x) + `(if (not (,test (,(string->symbol (string-append x func)) ,val) ,val)) + (error ,(string-append "Error in test " x func)))) + (list "in-" "inr-" "out-" "outr-" "inout-" "inoutr-")))) + +(define (=~ a b) + (< (abs (- a b)) 1e-5)) + +(check "bool" #t and) +(check "int" -2 =) +(check "long" -32 =) +(check "short" -15 =) +(check "uint" 75 =) +(check "ushort" 123 =) +(check "ulong" 462 =) +;(check "uchar" 16 =) +;(check "schar" -53 =) +(check "float" 4.3 =~) +(check "double" -175.42 =~) +;(check "longlong" 1634 =) +;(check "ulonglong" 6432 =) + +(let ((lst (inoutr-int2 3 -2))) + (if (not (and (= (car lst) 3) (= (cadr lst) -2))) + (error "Error in inoutr-int2"))) + +(let ((lst (out-foo 4))) + (if (not (and (= (Foo-a-get (car lst)) 4) (= (cadr lst) 8))) + (error "Error in out-foo"))) + +(exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/li_typemaps_proxy.scm b/SWIG/Examples/test-suite/schemerunme/li_typemaps_proxy.scm new file mode 100644 index 000000000..7611602d2 --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/li_typemaps_proxy.scm @@ -0,0 +1,34 @@ +(define-macro (check func val test) + (cons 'begin + (map + (lambda (x) + `(if (not (,test (,(string->symbol (string-append x func)) ,val) ,val)) + (error ,(string-append "Error in test " x func)))) + (list "in-" "inr-" "out-" "outr-" "inout-" "inoutr-")))) + +(define (=~ a b) + (< (abs (- a b)) 1e-5)) + +(check "bool" #t and) +(check "int" -2 =) +(check "long" -32 =) +(check "short" -15 =) +(check "uint" 75 =) +(check "ushort" 123 =) +(check "ulong" 462 =) +;(check "uchar" 16 =) +;(check "schar" -53 =) +(check "float" 4.3 =~) +(check "double" -175.42 =~) +(check "longlong" 1634 =) +(check "ulonglong" 6432 =) + +(let ((lst (inoutr-int2 3 -2))) + (if (not (and (= (car lst) 3) (= (cadr lst) -2))) + (error "Error in inoutr-int2"))) + +(let ((lst (out-foo 4))) + (if (not (and (= (slot-ref (car lst) 'a) 4) (= (cadr lst) 8))) + (error "Error in out-foo"))) + +(exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/multiple_inheritance_proxy.scm b/SWIG/Examples/test-suite/schemerunme/multiple_inheritance_proxy.scm new file mode 100644 index 000000000..feddbd28b --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/multiple_inheritance_proxy.scm @@ -0,0 +1,15 @@ +(define-macro (check test) + `(if (not ,test) (error "Error in test" ',test))) + +(define b (make )) +(check (= (bar b) 1)) + +(define f (make )) +(check (= (foo f) 2)) + +(define fb (make )) +(check (= (bar fb) 1)) +(check (= (foo fb) 2)) +(check (= (fooBar fb) 3)) + +(exit 0) diff --git a/SWIG/Examples/test-suite/schemerunme/unions_proxy.scm b/SWIG/Examples/test-suite/schemerunme/unions_proxy.scm new file mode 100644 index 000000000..43cb83611 --- /dev/null +++ b/SWIG/Examples/test-suite/schemerunme/unions_proxy.scm @@ -0,0 +1,37 @@ +;;; 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 (make )) +(slot-set! small 'jill 200) + +(define big (make )) +(slot-set! big 'smallstruct small) +(slot-set! big 'jack 300) + +;; Use SmallStruct then BigStruct to setup EmbeddedUnionTest. +;; Ensure values in EmbeddedUnionTest are set correctly for each. +(define eut (make )) + +;; First check the SmallStruct in EmbeddedUnionTest +(slot-set! eut 'number 1) +(slot-set! (slot-ref eut 'uni) 'small small) +(let ((Jill1 (slot-ref + (slot-ref + (slot-ref eut 'uni) + 'small) + 'jill))) + (if (not (= Jill1 200)) + (begin + (display "Runtime test 1 failed.") + (exit 1)))) + +(let ((Num1 (slot-ref eut 'number))) + (if (not (= Num1 1)) + (begin + (display "Runtime test 2 failed.") + (exit 1)))) + +;; that should do + +(exit 0) diff --git a/SWIG/Lib/chicken/chicken.swg b/SWIG/Lib/chicken/chicken.swg index 4f8881396..c723c6fc1 100644 --- a/SWIG/Lib/chicken/chicken.swg +++ b/SWIG/Lib/chicken/chicken.swg @@ -177,11 +177,11 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), %typemap(freearg) char * "if ($1 != NULL) { free ($1); }" /* Pointers, references, and arrays */ -%typemap(in) SWIGTYPE *, SWIGTYPE [], SWIGTYPE & { +%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *, SWIGTYPE [], SWIGTYPE & { $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, $disown); } -%typemap(in) SWIGTYPE *DISOWN { +%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *DISOWN { $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, SWIG_POINTER_DISOWN); } @@ -215,30 +215,30 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), $1 = SWIG_MustGetPtr($input, NULL, 1, 0); } -%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { +%typemap(out,chickenfastproxy="1") SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] { C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); - $result = SWIG_NewPointerObj ($1, $descriptor, $owner); + $result = SWIG_NewPointerObjProxy($1, $descriptor, $owner, $proxy); } -%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC { +%typemap(out,chickenfastproxy="1") SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC { C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1); - $result = SWIG_NewPointerObj ($1, ty, $owner); + $result = SWIG_NewPointerObjProxy($1, ty, $owner, $proxy); } -%typemap(varout) SWIGTYPE *, SWIGTYPE [] { +%typemap(varout,chickenfastproxy="1") SWIGTYPE *, SWIGTYPE [] { C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); - $result = SWIG_NewPointerObj ($varname, $descriptor, 0); + $result = SWIG_NewPointerObjProxy($varname, $descriptor, 0, 0); } -%typemap(varout) SWIGTYPE & { +%typemap(varout,chickenfastproxy="1") SWIGTYPE & { C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); - $result = SWIG_NewPointerObj((void *) &$varname, $1_descriptor, 0); + $result = SWIG_NewPointerObjProxy((void *) &$varname, $1_descriptor, 0, 0); } /* Pass-by-value */ -%typemap(in) SWIGTYPE($&1_ltype argp) { +%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE($&1_ltype argp) { argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0); $1 = *argp; } @@ -249,13 +249,13 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), $1 = *argp; } -%typemap(out) SWIGTYPE +%typemap(out,chickenfastproxy="1") SWIGTYPE #ifdef __cplusplus { $&1_ltype resultptr; C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); resultptr = new $1_ltype(($1_ltype &) $1); - $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 1); + $result = SWIG_NewPointerObjProxy(resultptr, $&1_descriptor, 1, $proxy); } #else { @@ -263,17 +263,17 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); resultptr = ($&1_ltype) malloc(sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type)); - $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1); + $result = SWIG_NewPointerObjProxy(resultptr, $&1_descriptor, 1,$proxy); } #endif -%typemap(varout) SWIGTYPE +%typemap(varout,chickenfastproxy="1") SWIGTYPE #ifdef __cplusplus { $&1_ltype resultptr; C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); resultptr = new $1_ltype(($1_ltype&) $1); - $result = SWIG_NewPointerObj (resultptr, $&1_descriptor, 0); + $result = SWIG_NewPointerObjProxy(resultptr, $&1_descriptor, 0, 0); } #else { @@ -281,7 +281,7 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double), C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER); resultptr = ($&1_ltype) malloc(sizeof($1_type)); memmove(resultptr, &$1, sizeof($1_type)); - $result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0); + $result = SWIG_NewPointerObjProxy(resultptr, $&1_descriptor, 0, 0); } #endif diff --git a/SWIG/Lib/chicken/chickenrun.swg b/SWIG/Lib/chicken/chickenrun.swg index d7b67662f..4a63b5a11 100644 --- a/SWIG/Lib/chicken/chickenrun.swg +++ b/SWIG/Lib/chicken/chickenrun.swg @@ -25,7 +25,9 @@ extern "C" { #define SWIG_MustGetPtr(s, type, argnum, flags) \ SWIG_Chicken_MustGetPtr(s, type, argnum, flags) #define SWIG_NewPointerObj(ptr, type, owner) \ - SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, &known_space) + SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, 1, &known_space) +#define SWIG_NewPointerObjProxy(ptr, type, owner, proxy) \ + SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, proxy, &known_space) #define swig_barf SWIG_Chicken_Barf #define SWIG_ThrowException(val) SWIG_Chicken_ThrowException(val) @@ -65,6 +67,19 @@ extern "C" { resultobjlast = tmp; \ } +/* given a SWIG pointer wrapped in a C_word, return the proxy create function, if any */ +#define SWIG_Chicken_FindCreateProxy(val, x) \ + if (C_swig_is_swigpointer(x)) { \ + swig_type_info *t = (swig_type_info *) C_block_item(x, 1); \ + if (t && t->clientdata && ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create) { \ + val = CHICKEN_gc_root_ref( ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create); \ + } else { \ + val = C_SCHEME_FALSE; \ + } \ + } else { \ + val = C_SCHEME_FALSE; \ + } + #define SWIG_POINTER_DISOWN 1 enum { @@ -216,7 +231,7 @@ SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer}; static C_word -SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data) +SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, int create_proxy, C_word **data) { swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata; @@ -231,7 +246,7 @@ SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word ** #endif /* wrap the result inside a proxy class if one is available */ - if (cdata && cdata->gc_proxy_create) { + if (create_proxy && cdata && cdata->gc_proxy_create) { C_word closure = CHICKEN_gc_root_ref(cdata->gc_proxy_create); if (C_swig_is_closurep(closure)) { C_save(cptr); @@ -281,10 +296,11 @@ static SWIGINLINE void * SWIG_Chicken_MustGetPtr (C_word s, swig_type_info *type, int argnum, int flags) { void *result; + char err_msg[256]; if (SWIG_Chicken_ConvertPtr(s, &result, type, flags)) { /* type mismatch */ - SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, - "Type error in argument %i: expected a %s.", argnum, type->name); + snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", argnum, (type->str ? type->str : type->name)); + SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg); } return result; } diff --git a/SWIG/Lib/chicken/std_string.i b/SWIG/Lib/chicken/std_string.i index 72faeb7c9..5b0b80b0b 100644 --- a/SWIG/Lib/chicken/std_string.i +++ b/SWIG/Lib/chicken/std_string.i @@ -7,7 +7,20 @@ namespace std { - class string; + %insert(closprefix) %{ (declare (hide )) %} + %nodefault string; + %rename("std-string") string; + class string { + public: + ~string() {} + }; + %extend string { + char *str; + } + %{ + #define std_string_str_get(s) ((char *)((s)->c_str())) + #define std_string_str_set(s,v) (s->assign((char *)(v))) + %} %typemap(typecheck) string = char *; %typemap(typecheck) const string & = char *; @@ -55,4 +68,25 @@ namespace std { C_word *space = C_alloc (C_SIZEOF_STRING (size)); $result = C_string (&space, size, (char *) $1->c_str()); } + + %typemap(varin) string { + if ($input == C_SCHEME_FALSE) { + $1 = std::string(); + } else { + char *tempptr; + if (!C_swig_is_string ($input)) { + swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, + "Argument #$argnum is not a string"); + } + tempptr = SWIG_MakeString($input); + $1 = std::string(tempptr); + if (tempptr) SWIG_free(tempptr); + } + } + + %typemap(varout) string { + int size = $1.size(); + C_word *space = C_alloc (C_SIZEOF_STRING (size)); + $result = C_string (&space, size, (char *) $1.c_str()); + } } diff --git a/SWIG/Lib/chicken/tinyclos-multi-generic.patch b/SWIG/Lib/chicken/tinyclos-multi-generic.patch index 2a85f1a63..2e585960e 100644 --- a/SWIG/Lib/chicken/tinyclos-multi-generic.patch +++ b/SWIG/Lib/chicken/tinyclos-multi-generic.patch @@ -3,13 +3,60 @@ # generics, that is, generics now correctly handle adding methods # with different lengths of specializer lists +# This patch has been committed into the CHICKEN darcs repository, +# so chicken versions above 1.92 work fine. + # Comments, bugs, suggestions send to chicken-users@nongnu.org # Patch written by John Lenz ---- tinyclos.scm.old 2005-04-04 23:35:10.000000000 -0500 -+++ tinyclos.scm 2005-04-05 14:03:26.740306763 -0500 -@@ -868,13 +868,24 @@ +--- tinyclos.scm.old 2005-04-05 01:13:56.000000000 -0500 ++++ tinyclos.scm 2005-04-11 16:37:23.746181489 -0500 +@@ -37,8 +37,10 @@ + + (include "parameters") + ++(cond-expand [(not chicken-compile-shared) (declare (unit tinyclos))] ++ [else] ) ++ + (declare +- (unit tinyclos) + (uses extras) + (usual-integrations) + (fixnum) +@@ -234,7 +236,10 @@ + y = C_block_item(y, 1); + } + } +- return(C_block_item(v, i + 1)); ++ if (x == C_SCHEME_END_OF_LIST && y == C_SCHEME_END_OF_LIST) ++ return(C_block_item(v, i + 1)); ++ else ++ goto mismatch; + } + else if(free_index == -1) free_index = i; + mismatch: +@@ -438,7 +443,7 @@ + (define hash-arg-list + (foreign-lambda* unsigned-int ((scheme-object args) (scheme-object svector)) " + C_word tag, h, x; +- int n, i, j; ++ int n, i, j, len = 0; + for(i = 0; args != C_SCHEME_END_OF_LIST; args = C_block_item(args, 1)) { + x = C_block_item(args, 0); + if(C_immediatep(x)) { +@@ -481,8 +486,9 @@ + default: i += 255; + } + } ++ ++len; + } +- return(i & (C_METHOD_CACHE_SIZE - 1));") ) ++ return((i + len) & (C_METHOD_CACHE_SIZE - 1));") ) + + + ; +@@ -868,13 +874,27 @@ (##tinyclos#slot-set! generic 'methods @@ -20,28 +67,49 @@ - [ms2 (method-specializers method)] ) - (not (every2 (lambda (x y) (eq? x y)) ms1 ms2) ) ) ) - (##tinyclos#slot-ref generic 'methods)))) ++ (let* ([ms1 (method-specializers method)] ++ [l1 (length ms1)] ) + (let filter-in-method ([methods (##tinyclos#slot-ref generic 'methods)]) -+ (if (null? methods) -+ (list method) -+ (let ([l1 (length (method-specializers method))] -+ [l2 (length (method-specializers (##sys#slot methods 0)))]) -+ (cond ((> l1 l2) -+ (cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1)))) -+ ((< l1 l2) -+ (cons method methods)) -+ (else -+ (let check-method ([ms1 (method-specializers method)] -+ [ms2 (method-specializers (##sys#slot methods 0))]) -+ (cond ((and (null? ms1) (null? ms2)) -+ (cons method (##sys#slot methods 1))) ;; skip the method already in the generic -+ ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0)) -+ (check-method (##sys#slot ms1 1) (##sys#slot ms2 1))) -+ (else -+ (cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1)))))))))))) ++ (if (null? methods) ++ (list method) ++ (let* ([mm (##sys#slot methods 0)] ++ [ms2 (method-specializers mm)] ++ [l2 (length ms2)]) ++ (cond ((> l1 l2) ++ (cons mm (filter-in-method (##sys#slot methods 1)))) ++ ((< l1 l2) ++ (cons method methods)) ++ (else ++ (let check-method ([ms1 ms1] ++ [ms2 ms2]) ++ (cond ((and (null? ms1) (null? ms2)) ++ (cons method (##sys#slot methods 1))) ;; skip the method already in the generic ++ ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0)) ++ (check-method (##sys#slot ms1 1) (##sys#slot ms2 1))) ++ (else ++ (cons mm (filter-in-method (##sys#slot methods 1))))))))))))) (if (memq generic generic-invocation-generics) (set! method-cache-tag (vector)) (%entity-cache-set! generic #f) ) -@@ -946,9 +957,13 @@ +@@ -925,11 +945,13 @@ + (memq (car args) generic-invocation-generics)) + (let ([proc + (method-procedure ++ ; select the first method of one argument + (let lp ([lis (generic-methods generic)]) +- (let ([tail (##sys#slot lis 1)]) +- (if (null? tail) +- (##sys#slot lis 0) +- (lp tail)) ) ) ) ] ) ++ (if (null? lis) ++ (##sys#error "Unable to find original compute-apply-generic") ++ (if (= (length (method-specializers (##sys#slot lis 0))) 1) ++ (##sys#slot lis 0) ++ (lp (##sys#slot lis 1)))))) ] ) + (lambda (args) (apply proc #f args)) ) + (let ([x (compute-apply-methods generic)] + [y ((compute-methods generic) args)] ) +@@ -946,9 +968,13 @@ (lambda (args) (let ([applicable (filter-in (lambda (method) @@ -58,7 +126,7 @@ (generic-methods generic) ) ] ) (if (or (null? applicable) (null? (##sys#slot applicable 1))) applicable -@@ -975,8 +990,10 @@ +@@ -975,8 +1001,10 @@ [else (cond ((and (null? specls1) (null? specls2)) (##sys#error "two methods are equally specific" generic)) @@ -71,12 +139,12 @@ ((null? args) (##sys#error "fewer arguments than specializers" generic)) (else -@@ -1235,7 +1252,7 @@ - (define (make-primitive-class "tcp-listener" )) - (define (make 'name "c++-object" 'direct-supers (list ) 'direct-slots '(this))) - --(set! method-caching-enabled #t) -+;(set! method-caching-enabled #t) - - - ;;; Utilities: +@@ -1210,7 +1238,7 @@ + (define (make-primitive-class "structure")) + (define (make-primitive-class "procedure" )) + (define (make-primitive-class "end-of-file")) +-(define (make-primitive-class "environment" )) ; (Benedikt insisted on this) ++(define (make-primitive-class "environment" )) + (define (make-primitive-class "hash-table" )) + (define (make-primitive-class "promise" )) + (define (make-primitive-class "queue" )) diff --git a/SWIG/Source/Modules/chicken.cxx b/SWIG/Source/Modules/chicken.cxx index b51fac880..8017ce5c3 100644 --- a/SWIG/Source/Modules/chicken.cxx +++ b/SWIG/Source/Modules/chicken.cxx @@ -50,12 +50,11 @@ static File *f_header = 0; static File *f_wrappers = 0; static File *f_init = 0; static String *chickentext = 0; -static String *closhelpers; +static String *closprefix = 0; static String *swigtype_ptr = 0; static String *f_sym_size = 0; -static String *closcode = 0; /* some options */ static int declare_unit = 1; @@ -67,18 +66,19 @@ static int clos = 0; static String *class_name = 0; static String *short_class_name = 0; -/* sections of the clos code */ -static String *clos_class_defines = 0; -static String *clos_methods = 0; - static int in_class = 0; static int have_constructor = 0; static bool exporting_destructor = false; static String *constructor_name = 0; -static String *memberfunction_name = 0; +static String *member_name = 0; +/* sections of the clos code */ +static String *clos_class_defines = 0; +static String *clos_methods = 0; + +/* Some clos options */ static int useclassprefix = 0; -static String *closprefix = 0; +static String *clossymnameprefix = 0; static int hide_primitive = 1; static Hash *primitive_names = 0; @@ -122,7 +122,6 @@ protected: }; /* ----------------------------------------------------------------------- -static String *closhelpers; * swig_chicken() - Instantiate module * ----------------------------------------------------------------------- */ @@ -134,17 +133,6 @@ extern "C" { Language * swig_chicken(void) { return new_swig_chicken(); } - - static int checkNodeClass(Node *n) { - String *kind = Getattr(n, "kind"); - if (kind && ( - Strcmp(kind, "class") == 0 || - Strcmp(kind, "struct") == 0 || - Strcmp(kind, "union") == 0)) - return 1; - else - return 0; - } } void @@ -158,15 +146,15 @@ CHICKEN::main(int argc, char *argv[]) for (i = 1; i < argc; i++) { if (argv[i]) { if (strcmp(argv[i], "-help") == 0) { - fputs(chicken_usage, stdout); - SWIG_exit(0); + fputs(chicken_usage, stdout); + SWIG_exit(0); } else if (strcmp(argv[i],"-proxy") == 0) { - clos = 1; - Swig_mark_arg(i); + clos = 1; + Swig_mark_arg(i); } else if (strcmp(argv[i],"-closprefix") == 0) { if (argv[i+1]) { - closprefix = NewString(argv[i+1]); + clossymnameprefix = NewString(argv[i+1]); Swig_mark_arg(i); Swig_mark_arg(i+1); i++; @@ -180,11 +168,11 @@ CHICKEN::main(int argc, char *argv[]) hide_primitive = 0; Swig_mark_arg(i); } else if (strcmp(argv[i],"-nounit") == 0) { - declare_unit = 0; - Swig_mark_arg(i); + declare_unit = 0; + Swig_mark_arg(i); } else if (strcmp(argv[i],"-noclosuses") == 0) { - clos_uses = 0; - Swig_mark_arg(i); + clos_uses = 0; + Swig_mark_arg(i); } else if (strcmp(argv[i],"-nocollection") == 0) { no_collection = 1; Swig_mark_arg(i); @@ -225,7 +213,7 @@ CHICKEN::top(Node *n) f_header = NewString(""); f_wrappers = NewString(""); chickentext = NewString(""); - closhelpers = NewString(""); + closprefix = NewString(""); f_sym_size = NewString(""); primitive_names = NewHash(); overload_parameter_lists = NewHash(); @@ -237,9 +225,8 @@ CHICKEN::top(Node *n) Swig_register_filebyname("init",f_init); Swig_register_filebyname("chicken", chickentext); - Swig_register_filebyname("closprefix", closhelpers); + Swig_register_filebyname("closprefix", closprefix); - closcode = NewString(""); clos_class_defines = NewString(""); clos_methods = NewString(""); @@ -285,24 +272,23 @@ CHICKEN::top(Node *n) } Printv(f_scm, - ";; -*- buffer-read-only: t -*- vi: set ro:\n", - ";; This file was created automatically by SWIG.\n", - ";; Don't modify this file, modify the SWIG interface instead.\n", - NIL); + ";; -*- buffer-read-only: t -*- vi: set ro:\n", + ";; This file was created automatically by SWIG.\n", + ";; Don't modify this file, modify the SWIG interface instead.\n", + NIL); if (declare_unit) Printv(f_scm,"(declare (unit ", scmmodule, "))\n\n", NIL); Printv(f_scm,"(declare \n", - tab4, "(hide swig-init swig-init-return)\n", - tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL); + tab4, "(hide swig-init swig-init-return)\n", + tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL); Printv(f_scm,"(define swig-init (##core#primitive \"swig_", module, - "_init\"))\n", NIL); + "_init\"))\n", NIL); Printv(f_scm,"(define swig-init-return (swig-init))\n\n", NIL); if (clos) { Printf (f_scm, "(declare (uses tinyclos))\n"); - Replaceall(closhelpers,"$module", scmmodule); - Printf (f_scm, "%s\n", closhelpers); - Printf (f_scm, "%s\n", closcode); + Replaceall(closprefix,"$module", scmmodule); + Printf (f_scm, "%s\n", closprefix); Printf (f_scm, "%s\n", clos_class_defines); Printf (f_scm, "%s\n", clos_methods); } @@ -325,10 +311,9 @@ CHICKEN::top(Node *n) Delete(chicken_filename); Delete(chickentext); - Delete(closhelpers); + Delete(closprefix); Delete(overload_parameter_lists); - Delete(closcode); Delete(clos_class_defines); Delete(clos_methods); @@ -364,13 +349,14 @@ CHICKEN::functionWrapper(Node *n) String *mangle = NewString(""); String *get_pointers; String *cleanup; - String *outarg; + String *argout; String *tm; String *overname = 0; String *declfunc = 0; String *scmname; bool any_specialized_arg = false; List *function_arg_types = NewList(); + int return_proxy_fastcall = 0; int num_required; int num_arguments; @@ -387,15 +373,13 @@ CHICKEN::functionWrapper(Node *n) wname = NewString(""); get_pointers = NewString(""); cleanup = NewString(""); - outarg = NewString(""); + argout = NewString(""); declfunc = NewString(""); scmname = NewString(iname); Replaceall(scmname, "_", "-"); /* Local vars */ Wrapper_add_local(f,"resultobj", "C_word resultobj"); - Wrapper_add_local(f,"resultobjlast", "C_word resultobjlast"); - Wrapper_add_local(f,"gswig_list_p", "int gswig_list_p = 0"); /* Write code to extract function parameters. */ emit_args(d, l, f); @@ -417,14 +401,14 @@ CHICKEN::functionWrapper(Node *n) Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL); Printv(f->def, - "static ", - "void ", wname, - " (C_word argc, C_word closure, C_word continuation", - NIL); + "static ", + "void ", wname, + " (C_word argc, C_word closure, C_word continuation", + NIL); Printv(declfunc, - "void ", wname, - "(C_word,C_word,C_word", - NIL); + "void ", wname, + "(C_word,C_word,C_word", + NIL); /* Generate code for argument marshalling */ for (i = 0, p=l; i < num_arguments; i++) { @@ -435,7 +419,6 @@ CHICKEN::functionWrapper(Node *n) SwigType *pt = Getattr(p,"type"); String *ln = Getattr(p,"lname"); - SwigType *pb = SwigType_typedef_resolve_all(SwigType_base(pt)); source = NewStringf("scm%d",i+1); @@ -446,35 +429,39 @@ CHICKEN::functionWrapper(Node *n) if ((tm = Getattr(p,"tmap:in"))) { String *parse = Getattr(p,"tmap:in:parse"); if (!parse) { - Replaceall(tm,"$source",source); - Replaceall(tm,"$target",ln); - Replaceall(tm,"$input", source); - Setattr(p,"emit:input", source); /* Save the location of - the object */ - - if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) { - Replaceall(tm,"$disown","SWIG_POINTER_DISOWN"); - } else { - Replaceall(tm,"$disown","0"); - } + Replaceall(tm,"$source",source); + Replaceall(tm,"$target",ln); + Replaceall(tm,"$input", source); + Setattr(p,"emit:input", source); /* Save the location of + the object */ + + if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) { + Replaceall(tm,"$disown","SWIG_POINTER_DISOWN"); + } else { + Replaceall(tm,"$disown","0"); + } - if (i >= num_required) - Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source); - Printv(get_pointers,tm,"\n", NIL); - if (i >= num_required) - Printv(get_pointers, "}\n", NIL); + if (i >= num_required) + Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source); + Printv(get_pointers,tm,"\n", NIL); + if (i >= num_required) + Printv(get_pointers, "}\n", NIL); if (clos) { if (i < num_required) { if (strcmp("void", Char(pt)) != 0) { - Node *class_node = Swig_symbol_clookup_check(pb, Getattr(n, "sym:symtab"), checkNodeClass); - if (class_node) { - String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name")); + Node *class_node = 0; + String *clos_code = Getattr(p, "tmap:in:closcode"); + class_node = classLookup(pt); + if (clos_code && class_node) { + String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name")); Append(function_arg_types, class_name); + Append(function_arg_types, Copy(clos_code)); any_specialized_arg = true; Delete(class_name); } else { Append(function_arg_types, ""); + Append(function_arg_types, "$input"); } } } @@ -488,8 +475,8 @@ CHICKEN::functionWrapper(Node *n) continue; } else { Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, - "Unable to use type %s as a function argument.\n", - SwigType_str(pt,0)); + "Unable to use type %s as a function argument.\n", + SwigType_str(pt,0)); break; } @@ -503,7 +490,7 @@ CHICKEN::functionWrapper(Node *n) Printf(declfunc, ")"); if (num_required != num_arguments) { - Push(function_arg_types, "^^##optional$$"); + Append(function_arg_types, "^^##optional$$"); } /* First check the number of arguments is correct */ @@ -540,6 +527,24 @@ CHICKEN::functionWrapper(Node *n) /* Emit the function call */ emit_action(n,f); + /* Insert argument output code */ + for (p = l; p;) { + if ((tm = Getattr(p,"tmap:argout"))) { + if (!Wrapper_check_local(f, "gswig_list_p")) { + Wrapper_add_local(f,"resultobjlast", "C_word resultobjlast"); + Wrapper_add_local(f,"gswig_list_p", "int gswig_list_p = 0"); + } + Replaceall(tm,"$source",Getattr(p,"lname")); + Replaceall(tm,"$target","resultobj"); + Replaceall(tm,"$arg",Getattr(p,"emit:input")); + Replaceall(tm,"$input",Getattr(p,"emit:input")); + Printf(argout, "%s", tm); + p = Getattr(p,"tmap:argout:next"); + } else { + p = nextSibling(p); + } + } + /* Return the function value */ if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) { Replaceall(tm,"$source", "result"); @@ -550,26 +555,26 @@ CHICKEN::functionWrapper(Node *n) } else { Replaceall(tm,"$owner","0"); } + + /* check for chickenfastproxy flag */ + if (Getattr(n, "tmap:out:chickenfastproxy")) { + /* can only do fast proxy if there are no argout paramaters... */ + if (Wrapper_check_local(f, "gswig_list_p")) { + Replaceall(tm, "$proxy", "1"); + } else { + Replaceall(tm, "$proxy", "0"); + return_proxy_fastcall = 1; + } + } Printf(f->code, "%s", tm); } else { Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, - "Unable to use return type %s in function %s.\n", - SwigType_str(d,0), name); + "Unable to use return type %s in function %s.\n", + SwigType_str(d,0), name); } - /* Insert argument output code */ - for (p = l; p;) { - if ((tm = Getattr(p,"tmap:argout"))) { - Replaceall(tm,"$source",Getattr(p,"lname")); - Replaceall(tm,"$target","resultobj"); - Replaceall(tm,"$arg",Getattr(p,"emit:input")); - Replaceall(tm,"$input",Getattr(p,"emit:input")); - Printf(f->code, "%s", tm); - p = Getattr(p,"tmap:argout:next"); - } else { - p = nextSibling(p); - } - } + /* Insert the argumetn output code */ + Printv(f->code, argout, NIL); /* Output cleanup code */ Printv(f->code,cleanup,NIL); @@ -588,14 +593,25 @@ CHICKEN::functionWrapper(Node *n) Printf(f->code,"%s\n",tm); } - Printf(f->code," C_kontinue (continuation, resultobj);\n"); + if (return_proxy_fastcall) { + Printv(f->code,"{\n", + "C_word func;\n", + "SWIG_Chicken_FindCreateProxy(func, resultobj);\n", + "if (C_swig_is_closurep(func))\n", + " ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n", + "else\n", + " C_kontinue(continuation, resultobj);\n", + "}\n", NIL); + } else { + Printf(f->code," C_kontinue (continuation, resultobj);\n"); + } /* Error handling code */ #ifdef USE_FAIL Printf(f->code,"fail:\n"); Printv(f->code,cleanup,NIL); Printf(f->code,"swig_panic (\"failure in " - "'$symname' SWIG function wrapper\");\n"); + "'$symname' SWIG function wrapper\");\n"); #endif Printf(f->code,"}\n"); @@ -608,8 +624,8 @@ CHICKEN::functionWrapper(Node *n) /* Dump the function out */ Printv(f_wrappers, - "static ", - declfunc, " C_noret;\n", NIL); + "static ", + declfunc, " C_noret;\n", NIL); Wrapper_print(f,f_wrappers); Setattr(n,"wrap:name", wname); @@ -624,13 +640,12 @@ CHICKEN::functionWrapper(Node *n) addMethod(scmname, wname); } - /* Only export if we are not in a class, or if in a class memberfunction (this protects against member variables - * and static functions and so forth, which are generated seperatly) */ - if (!in_class || memberfunction_name) { + /* Only export if we are not in a class, or if in a class memberfunction */ + if (!in_class || member_name) { String *method_def; String *clos_name; if (in_class) - clos_name = NewString(memberfunction_name); + clos_name = NewString(member_name); else clos_name = chickenNameMapping(scmname, (char *)""); @@ -668,7 +683,6 @@ CHICKEN::functionWrapper(Node *n) Delete(wname); Delete(get_pointers); Delete(cleanup); - Delete(outarg); Delete(declfunc); Delete(mangle); Delete(function_arg_types); @@ -732,14 +746,14 @@ CHICKEN::variableWrapper(Node *n) { if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) { Printv(f->def, - "static ", - "void ",wname,"(C_word, C_word, C_word, C_word) C_noret;\n", - NIL); + "static ", + "void ",wname,"(C_word, C_word, C_word, C_word) C_noret;\n", + NIL); Printv(f->def, - "static " - "void ",wname,"(C_word argc, C_word closure, " - "C_word continuation, C_word value) {\n", - NIL); + "static " + "void ",wname,"(C_word argc, C_word closure, " + "C_word continuation, C_word value) {\n", + NIL); Wrapper_add_local(f, "resultobj", "C_word resultobj"); @@ -749,15 +763,15 @@ CHICKEN::variableWrapper(Node *n) { if (!Getattr(n,"feature:immutable")) { Printf(f->code, "if (argc > 2) {\n"); if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) { - Replaceall(tm,"$source","value"); - Replaceall(tm,"$target",name); - Replaceall(tm,"$input","value"); - Printv(f->code, tm, "\n",NIL); + Replaceall(tm,"$source","value"); + Replaceall(tm,"$target",name); + Replaceall(tm,"$input","value"); + Printv(f->code, tm, "\n",NIL); } else { - Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, - "Unable to set variable of type %s.\n", - SwigType_str(t,0)); + Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, + "Unable to set variable of type %s.\n", + SwigType_str(t,0)); } Printf(f->code, "}\n"); } @@ -780,15 +794,27 @@ CHICKEN::variableWrapper(Node *n) { } else { Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, - "Unable to read variable of type %s\n", SwigType_str(t,0)); + "Unable to read variable of type %s\n", SwigType_str(t,0)); } - Printf(f->code,"\nC_kontinue (continuation, resultobj);\n"); - + + if (Getattr(n, "tmap:varout:chickenfastproxy")) { + Printv(f->code,"{\n", + "C_word func;\n", + "SWIG_Chicken_FindCreateProxy(func, resultobj);\n", + "if (C_swig_is_closurep(func))\n", + " ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n", + "else\n", + " C_kontinue(continuation, resultobj);\n", + "}\n", NIL); + } else { + Printf(f->code," C_kontinue (continuation, resultobj);\n"); + } + /* Error handling code */ #ifdef USE_FAIL Printf(f->code,"fail:\n"); Printf(f->code,"swig_panic (\"failure in " - "'%s' SWIG wrapper\");\n", proc_name); + "'%s' SWIG wrapper\");\n", proc_name); #endif Printf(f->code,"}\n"); @@ -797,18 +823,27 @@ CHICKEN::variableWrapper(Node *n) { /* Now register the variable with the interpreter. */ addMethod(scmname, wname); - if (!in_class) { - String *class_name = SwigType_typedef_resolve_all(SwigType_base(t)); - String *clos_name = chickenNameMapping(scmname, (char *)""); - /* Simply re-export the procedure */ - Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL); - Delete(class_name); + if (!in_class || member_name) { + String *clos_name; + if (in_class) + clos_name = NewString(member_name); + else + clos_name = chickenNameMapping(scmname, (char *)""); + + Node *class_node = classLookup(t); + if (class_node && Getattr(n, "tmap:varout:chickenfastproxy")) { + Printv(clos_methods, "(define (", clos_name, " . lst) (if (null? lst) (", chickenPrimitiveName(scmname), ") (", + chickenPrimitiveName(scmname), " (slot-ref (car lst) 'swig-this))))\n", NIL); + } else { + /* Simply re-export the procedure */ + Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL); + } Delete(clos_name); } } else { Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, - "Unsupported variable type %s (ignored).\n", - SwigType_str(t,0)); + "Unsupported variable type %s (ignored).\n", + SwigType_str(t,0)); } Delete(wname); @@ -898,7 +933,7 @@ CHICKEN::constantWrapper(Node *n) } else { Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, - "Unsupported constant value.\n"); + "Unsupported constant value.\n"); return SWIG_NOWRAP; } @@ -922,15 +957,15 @@ CHICKEN::constantWrapper(Node *n) if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) { Printv(f->def, - "static ", - "void ",wname,"(C_word, C_word, C_word) C_noret;\n", - NIL); + "static ", + "void ",wname,"(C_word, C_word, C_word) C_noret;\n", + NIL); Printv(f->def, - "static ", - "void ",wname,"(C_word argc, C_word closure, " - "C_word continuation) {\n", - NIL); + "static ", + "void ",wname,"(C_word argc, C_word closure, " + "C_word continuation) {\n", + NIL); Wrapper_add_local(f, "resultobj", "C_word resultobj"); @@ -947,15 +982,27 @@ CHICKEN::constantWrapper(Node *n) } else { Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, - "Unable to read variable of type %s\n", SwigType_str(t,0)); + "Unable to read variable of type %s\n", SwigType_str(t,0)); } - Printf(f->code,"\nC_kontinue (continuation, resultobj);\n"); - + + if (Getattr(n, "tmap:varout:chickenfastproxy")) { + Printv(f->code,"{\n", + "C_word func;\n", + "SWIG_Chicken_FindCreateProxy(func, resultobj);\n", + "if (C_swig_is_closurep(func))\n", + " ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n", + "else\n", + " C_kontinue(continuation, resultobj);\n", + "}\n", NIL); + } else { + Printf(f->code," C_kontinue (continuation, resultobj);\n"); + } + /* Error handling code */ #ifdef USE_FAIL Printf(f->code,"fail:\n"); Printf(f->code,"swig_panic (\"failure in " - "'%s' SWIG wrapper\");\n", proc_name); + "'%s' SWIG wrapper\");\n", proc_name); #endif Printf(f->code,"}\n"); @@ -964,16 +1011,20 @@ CHICKEN::constantWrapper(Node *n) /* Now register the variable with the interpreter. */ addMethod(scmname, wname); - if (!in_class) { - String *clos_name = chickenNameMapping(scmname, (char *)""); + if (!in_class || member_name) { + String *clos_name; + if (in_class) + clos_name = NewString(member_name); + else + clos_name = chickenNameMapping(scmname, (char *)""); Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL); Delete(clos_name); } } else { Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, - "Unsupported variable type %s (ignored).\n", - SwigType_str(t,0)); + "Unsupported variable type %s (ignored).\n", + SwigType_str(t,0)); } Delete(wname); @@ -1014,9 +1065,9 @@ CHICKEN::classHandler(Node *n) while (base.item) { Printv(base_class, Getattr(base.item, "sym:name"),NIL); base = Next(base); - if (base.item) { - Printf(base_class, "> <"); - } + if (base.item) { + Printf(base_class, "> <"); + } } } Printf(base_class, ">"); @@ -1026,7 +1077,7 @@ CHICKEN::classHandler(Node *n) Replaceall(scmmod, "_", "-"); Printv(clos_class_defines,"(define ", class_name, "\n", - " (make 'name '", class_name, "\n", NIL); + " (make 'name \"", short_class_name, "\"\n", NIL); Delete(scmmod); if (Len(base_class) > 2) { @@ -1057,7 +1108,7 @@ CHICKEN::classHandler(Node *n) if (have_constructor) { Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", - " (swig-initialize obj initargs ", NIL); + " (swig-initialize obj initargs ", NIL); if (constructor_arg_types) { String *initfunc_name = NewStringf("%s@@SWIG@initmethod", class_name); String *func_call = buildClosFunctionCall(constructor_arg_types, initfunc_name, chickenPrimitiveName(constructor_name)); @@ -1079,8 +1130,8 @@ CHICKEN::classHandler(Node *n) constructor_name = 0; } else { Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", - " (swig-initialize obj initargs (lambda x #f)))\n", - NIL); + " (swig-initialize obj initargs (lambda x #f)))\n", + NIL); } /* export class initialization function */ @@ -1093,9 +1144,9 @@ CHICKEN::classHandler(Node *n) Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n", "static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n", " C_trace(\"", funcname, "\");\n", - " if (argc!=3) C_bad_argc(argc,3);\n", - " swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr,"->clientdata;\n", - " cdata->gc_proxy_create = CHICKEN_new_gc_root();\n", + " if (argc!=3) C_bad_argc(argc,3);\n", + " swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr,"->clientdata;\n", + " cdata->gc_proxy_create = CHICKEN_new_gc_root();\n", " CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n", " C_kontinue(continuation, C_SCHEME_UNDEFINED);\n", "}\n", NIL); @@ -1126,10 +1177,10 @@ CHICKEN::memberfunctionHandler(Node *n) String *proc = NewString(iname); Replaceall(proc, "_", "-"); - memberfunction_name = chickenNameMapping(proc, short_class_name); + member_name = chickenNameMapping(proc, short_class_name); Language::memberfunctionHandler(n); - Delete(memberfunction_name); - memberfunction_name = NULL; + Delete(member_name); + member_name = NULL; Delete(proc); return SWIG_OK; @@ -1142,10 +1193,10 @@ CHICKEN::staticmemberfunctionHandler(Node *n) String *proc = NewString(iname); Replaceall(proc, "_", "-"); - memberfunction_name = NewStringf("%s-%s", short_class_name, proc); + member_name = NewStringf("%s-%s", short_class_name, proc); Language::staticmemberfunctionHandler(n); - Delete(memberfunction_name); - memberfunction_name = NULL; + Delete(member_name); + member_name = NULL; Delete(proc); return SWIG_OK; @@ -1155,14 +1206,15 @@ int CHICKEN::membervariableHandler(Node *n) { String *iname = Getattr(n,"sym:name"); - String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type"))); + //String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type"))); Language::membervariableHandler(n); String *proc = NewString(iname); Replaceall(proc,"_","-"); - Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab")); + //Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab")); + Node *class_node = classLookup(Getattr(n, "type")); String *getfunc = NewStringf("%s-%s-get", short_class_name, proc); String *setfunc = NewStringf("%s-%s-set", short_class_name, proc); @@ -1186,30 +1238,17 @@ CHICKEN::membervariableHandler(Node *n) int CHICKEN::staticmembervariableHandler(Node *n) { - String *iname = Getattr(n, "sym:name"); - String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type"))); + String *iname = Getattr(n, "sym:name"); + String *proc = NewString(iname); + Replaceall(proc, "_", "-"); - Language::staticmembervariableHandler(n); + member_name = NewStringf("%s-%s", short_class_name, proc); + Language::staticmembervariableHandler(n); + Delete(member_name); + member_name = NULL; + Delete(proc); - String *proc = NewString(iname); - Replaceall(proc, "_", "-"); - - String *closprocname = chickenNameMapping(proc, short_class_name); - - Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab")); - - String *primfunc = NewStringf("%s-%s", short_class_name, proc); - - if (class_node) { - Printv(clos_methods, "(define (", closprocname, " . lst) (if (null? lst) (", chickenPrimitiveName(primfunc), ") (", - chickenPrimitiveName(primfunc), " (slot-ref (car lst) 'swig-this))))\n", NIL); - } else { - Printv(clos_methods, "(define ", closprocname, " ", chickenPrimitiveName(primfunc), ")\n", NIL); - } - - Delete(closprocname); - - return SWIG_OK; + return SWIG_OK; } int @@ -1249,7 +1288,7 @@ int CHICKEN::importDirective(Node *n) { if (mod) { String *name = Getattr(mod, "name"); if (name) { - Printf(closcode, "(declare (uses %s))\n", name); + Printf(closprefix, "(declare (uses %s))\n", name); } } } @@ -1271,11 +1310,17 @@ String *CHICKEN::buildClosFunctionCall(List *types, String_or_char *closname, St optional_arguments = 1; } else { Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item); - if (Strcmp(arg_type.item, "") == 0) { - Printf(func_args, " arg%i", arg_count); - } else { - Printf(func_args, " (slot-ref arg%i 'swig-this)", arg_count); - } + arg_type = Next(arg_type); + if (!arg_type.item) break; + + String *arg = NewStringf("arg%i", arg_count); + String *access_arg = Copy(arg_type.item); + + Replaceall(access_arg, "$input", arg); + Printf(func_args, " %s", access_arg); + + Delete(arg); + Delete(access_arg); } arg_count++; } @@ -1296,17 +1341,10 @@ String *CHICKEN::buildClosFunctionCall(List *types, String_or_char *closname, St extern "C" { - /* This compares first based on the position of the last non-primitive argument, - * then if the positions are equal, comparing on non-primitive names */ - static int compareTypeLists(const DOH *a, const DOH *b) { + /* compares based on non-primitive names */ + static int compareTypeListsHelper(const DOH *a, const DOH *b, int opt_equal) { List *la = (List *) a; List *lb = (List *) b; - int la_len = Len(la); - int lb_len = Len(lb); - - /* We want longer lists to come before shorter lists */ - if (la_len < lb_len) return 1; - if (la_len > lb_len) return -1; Iterator ia = First(la); Iterator ib = First(lb); @@ -1314,13 +1352,25 @@ extern "C" { while (ia.item && ib.item) { int ret = Strcmp(ia.item, ib.item); if (ret) return ret; - ia = Next(ia); - ib = Next(ib); + ia = Next(Next(ia)); + ib = Next(Next(ib)); } + if (opt_equal && ia.item && Strcmp(ia.item, "^^##optional$$") == 0) + return 0; + if (ia.item) + return -1; + if (opt_equal && ib.item && Strcmp(ib.item, "^^##optional$$") == 0) + return 0; + if (ib.item) + return 1; + return 0; } + static int compareTypeLists(const DOH *a, const DOH *b) { + return compareTypeListsHelper(a, b, 0); + } } void @@ -1331,9 +1381,9 @@ CHICKEN::dispatchFunction(Node *n) int maxargs; String *tmp = NewString(""); String *dispatch = - Swig_overload_dispatch(n,"%s (2+argc,closure," - "continuation$commaargs);", &maxargs); - + Swig_overload_dispatch(n,"%s (2+$numargs,closure," + "continuation$commaargs);", &maxargs); + /* Generate a dispatch wrapper for all overloaded functions */ Wrapper *f = NewWrapper(); @@ -1345,13 +1395,13 @@ CHICKEN::dispatchFunction(Node *n) Append(wname, Swig_name_wrapper(iname)); Printv(f->def, "static void real_", wname, - "(C_word, C_word, C_word, C_word) C_noret;\n", NIL); + "(C_word, C_word, C_word, C_word) C_noret;\n", NIL); Printv(f->def, - "static void real_", - wname, - "(C_word oldargc, C_word closure, C_word continuation, C_word args) {", - NIL); + "static void real_", + wname, + "(C_word oldargc, C_word closure, C_word continuation, C_word args) {", + NIL); Wrapper_add_local(f,"argc","int argc"); Printf(tmp,"C_word argv[%d]", maxargs+1); @@ -1360,7 +1410,7 @@ CHICKEN::dispatchFunction(Node *n) Wrapper_add_local(f,"t","C_word t = args"); Printf(f->code,"if (!C_swig_is_list (args)) {\n"); Printf(f->code," swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, " - "\"Argument #1 must be a list of overloaded arguments\");\n"); + "\"Argument #1 must be a list of overloaded arguments\");\n"); Printf(f->code,"}\n"); Printf(f->code,"argc = C_unfix (C_i_length (args));\n"); Printf(f->code,"for (ii = 0; (ii < argc) && (ii < %d); ii++, t = C_block_item (t, 1)) {\n",maxargs); @@ -1369,7 +1419,7 @@ CHICKEN::dispatchFunction(Node *n) Printv(f->code,dispatch,"\n",NIL); Printf(f->code,"swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE," - "\"No matching function for overloaded '%s'\");\n", iname); + "\"No matching function for overloaded '%s'\");\n", iname); Printv(f->code,"}\n",NIL); Wrapper_print(f,f_wrappers); addMethod(scmname, wname); @@ -1379,18 +1429,18 @@ CHICKEN::dispatchFunction(Node *n) /* varargs */ Printv(f->def, "void ", wname, - "(C_word, C_word, C_word, ...) C_noret;\n", NIL); + "(C_word, C_word, C_word, ...) C_noret;\n", NIL); Printv(f->def, "void ", wname, - "(C_word c, C_word t0, C_word t1, ...) {", - NIL); + "(C_word c, C_word t0, C_word t1, ...) {", + NIL); Printv(f->code, - "C_word t2;\n", - "va_list v;\n", - "C_word *a, c2 = c;\n", - "C_save_rest (t1, c2, 2);\n", - "a = C_alloc((c-2)*3);\n", - "t2 = C_restore_rest (a, C_rest_count (0));\n", - "real_", wname, " (3, t0, t1, t2);\n", NIL); + "C_word t2;\n", + "va_list v;\n", + "C_word *a, c2 = c;\n", + "C_save_rest (t1, c2, 2);\n", + "a = C_alloc((c-2)*3);\n", + "t2 = C_restore_rest (a, C_rest_count (0));\n", + "real_", wname, " (3, t0, t1, t2);\n", NIL); Printv(f->code,"}\n",NIL); Wrapper_print(f,f_wrappers); @@ -1411,7 +1461,7 @@ CHICKEN::dispatchFunction(Node *n) construct = 1; Printf(clos_methods, "(declare (hide %s))\n", clos_name); } else if (in_class) - clos_name = NewString(memberfunction_name); + clos_name = NewString(member_name); else clos_name = chickenNameMapping(scmname, (char *)""); @@ -1423,7 +1473,7 @@ CHICKEN::dispatchFunction(Node *n) String *newlist = NewList(); for (f = First(flist); f.item; f = Next(f)) { /* check if cur is a duplicate of prev */ - if (prev && compareTypeLists(f.item, prev) == 0) { + if (prev && compareTypeListsHelper(f.item, prev, 1) == 0) { Delete(f.item); } else { Append(newlist, f.item); @@ -1482,15 +1532,15 @@ CHICKEN::addMethod(String *scheme_name, String *function) " C_word *p0 = a;\n", " *(a++)=C_CLOSURE_TYPE|1;\n", " *(a++)=(C_word)", function, ";\n", - " C_mutate(return_vec++, (C_word)p0);\n", - "}\n", NIL); + " C_mutate(return_vec++, (C_word)p0);\n", + "}\n", NIL); } else { Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym)); Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n", - Len(sym), sym); + Len(sym), sym); 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); + "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); } if (hide_primitive) { @@ -1523,22 +1573,22 @@ CHICKEN::validIdentifier(String *s) /* --> * | */ /* --> | */ if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%') - || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') - || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') - || (*c == '^') || (*c == '_') || (*c == '~'))) { + || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') + || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') + || (*c == '^') || (*c == '_') || (*c == '~'))) { /* --> + | - | ... */ if ((strcmp(c, "+") == 0) - || strcmp(c, "-") == 0 - || strcmp(c, "...") == 0) return 1; + || strcmp(c, "-") == 0 + || strcmp(c, "...") == 0) return 1; else return 0; } /* --> | | */ while (*c) { if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%') - || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') - || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') - || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+') - || (*c == '-') || (*c == '.') || (*c == '@'))) return 0; + || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') + || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') + || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+') + || (*c == '-') || (*c == '.') || (*c == '@'))) return 0; c++; } return 1; @@ -1556,8 +1606,8 @@ CHICKEN::validIdentifier(String *s) if (Strcmp(class_name, "") == 0) { // not part of a class, so no class name to prefix - if (closprefix) { - Printf(n, "%s%s", closprefix, name); + if (clossymnameprefix) { + Printf(n, "%s%s", clossymnameprefix, name); } else { Printf(n, "%s", name); } @@ -1565,8 +1615,8 @@ CHICKEN::validIdentifier(String *s) if (useclassprefix) { Printf(n, "%s-%s", class_name, name); } else { - if (closprefix) { - Printf(n, "%s%s", closprefix, name); + if (clossymnameprefix) { + Printf(n, "%s%s", clossymnameprefix, name); } else { Printf(n, "%s", name); }