[Chicken] Remove code for Chicken
We dropped support for it in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2 years. See #2009.
This commit is contained in:
Olly Betts
parent
3f78ea64c0
commit
5f38f9cc78
107 changed files with 10 additions and 5763 deletions
|
|
@ -44,8 +44,6 @@
|
|||
// unsigned char* as strings
|
||||
#if defined(SWIGJAVA) || defined(SWIGCSHARP)
|
||||
|
||||
/* Note: Chicken does not allow unsigned char * in strings */
|
||||
|
||||
%apply char [ANY] {TAscii[ANY]}
|
||||
%apply char [] {TAscii []}
|
||||
%apply char * {TAscii *}
|
||||
|
|
|
|||
|
|
@ -1,101 +0,0 @@
|
|||
#######################################################################
|
||||
# Makefile for chicken test-suite
|
||||
#######################################################################
|
||||
|
||||
LANGUAGE = chicken
|
||||
VARIANT =
|
||||
SCRIPTSUFFIX = _runme.ss
|
||||
PROXYSUFFIX = _runme_proxy.ss
|
||||
|
||||
srcdir = @srcdir@
|
||||
top_srcdir = @top_srcdir@
|
||||
top_builddir = @top_builddir@
|
||||
|
||||
CHICKEN_CSI = @CHICKEN_CSI@ -quiet -batch -no-init
|
||||
SO = @SO@
|
||||
|
||||
#C_TEST_CASES = long_long list_vector pointer_in_out multivalue
|
||||
|
||||
# Skip the STD cases for now, except for li_std_string.i
|
||||
SKIP_CPP_STD_CASES = Yes
|
||||
|
||||
CPP_TEST_CASES += li_std_string
|
||||
|
||||
EXTRA_TEST_CASES += chicken_ext_test.externaltest
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
|
||||
# Overridden variables here
|
||||
SWIGOPT += -nounit
|
||||
|
||||
# Custom tests - tests with additional commandline options
|
||||
# If there exists a PROXYSUFFIX runme file, we also generate the wrapper
|
||||
# with the -proxy argument
|
||||
%.cppproxy: SWIGOPT += -proxy
|
||||
%.cppproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
|
||||
|
||||
%.cproxy: SWIGOPT += -proxy
|
||||
%.cproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
|
||||
|
||||
%.multiproxy: SWIGOPT += -proxy -noclosuses
|
||||
%.multiproxy: SCRIPTSUFFIX = $(PROXYSUFFIX)
|
||||
|
||||
# Rules for the different types of tests
|
||||
%.cpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_cpp)
|
||||
$(run_testcase)
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
|
||||
$(MAKE) $*.cppproxy; \
|
||||
fi
|
||||
|
||||
%.ctest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_c)
|
||||
$(run_testcase)
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
|
||||
$(MAKE) $*.cproxy; \
|
||||
fi
|
||||
|
||||
%.multicpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_multi_cpp)
|
||||
$(run_testcase)
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(PROXYSUFFIX) ]; then \
|
||||
$(MAKE) $*.multiproxy; \
|
||||
fi
|
||||
|
||||
%.externaltest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_external)
|
||||
$(run_testcase)
|
||||
|
||||
%.cppproxy:
|
||||
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
|
||||
+$(swig_and_compile_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
%.cproxy:
|
||||
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
|
||||
+$(swig_and_compile_c)
|
||||
$(run_testcase)
|
||||
|
||||
%.multiproxy:
|
||||
echo "$(ACTION)ing $(LANGUAGE) testcase $* (with run test) with -proxy"
|
||||
+$(swig_and_compile_multi_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
# Runs the testcase. A testcase is only run if
|
||||
# a file is found which has _runme.scm appended after the testcase name.
|
||||
run_testcase = \
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
|
||||
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(CHICKEN_CSI) $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
|
||||
fi
|
||||
|
||||
# Clean
|
||||
%.clean:
|
||||
@exit 0
|
||||
|
||||
clean:
|
||||
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' chicken_clean
|
||||
rm -f *.scm
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
See ../README for common README file.
|
||||
|
||||
Any testcases which have _runme.ss appended after the testcase name will be detected and run.
|
||||
NOTE: I had to use _runme.ss because otherwise it would be hard to implement make clean
|
||||
Since when SWIG runs it generates an example.scm file for every test, to clean those files
|
||||
I needed to add a rm -f *.scm to make clean. But we don't want the runme scripts to
|
||||
disappear as well!
|
||||
|
||||
Any testcases which have _runme_proxy.ss appended after the testcase name will be detected
|
||||
and run with the -proxy argument passed to SWIG. SWIG will not be run with the -unhide-primitive
|
||||
option, so the _runme_proxy.ss file must use only the tinyclos exported interface.
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "casts.so")
|
||||
(include "../schemerunme/casts.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "char_constant.so")
|
||||
(include "../schemerunme/char_constant.scm")
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
#include <chicken/chicken_ext_test_wrap_hdr.h>
|
||||
#include <imports_a.h>
|
||||
|
||||
void test_create(C_word,C_word,C_word) C_noret;
|
||||
void test_create(C_word argc, C_word closure, C_word continuation) {
|
||||
C_word resultobj;
|
||||
swig_type_info *type;
|
||||
A *newobj;
|
||||
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
|
||||
|
||||
C_trace("test-create");
|
||||
if (argc!=2) C_bad_argc(argc,2);
|
||||
|
||||
|
||||
newobj = new A();
|
||||
|
||||
type = SWIG_TypeQuery("A *");
|
||||
resultobj = SWIG_NewPointerObj(newobj, type, 1);
|
||||
|
||||
C_kontinue(continuation, resultobj);
|
||||
}
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(load "chicken_ext_test.so")
|
||||
|
||||
(define a (test-create))
|
||||
|
||||
(A-hello a)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "class_ignore.so")
|
||||
(include "../schemerunme/class_ignore.scm")
|
||||
|
|
@ -1,95 +0,0 @@
|
|||
(require 'clientdata_prop_a)
|
||||
(require 'clientdata_prop_b)
|
||||
|
||||
(define a (make <A>))
|
||||
(test-A a)
|
||||
(test-tA a)
|
||||
(test-t2A a)
|
||||
(test-t3A a)
|
||||
(fA a)
|
||||
|
||||
(define b (make <B>))
|
||||
(test-A b)
|
||||
(test-tA b)
|
||||
(test-t2A b)
|
||||
(test-t3A b)
|
||||
(test-B b)
|
||||
(fA b)
|
||||
(fB b)
|
||||
|
||||
(define c (make <C>))
|
||||
(test-A c)
|
||||
(test-tA c)
|
||||
(test-t2A c)
|
||||
(test-t3A c)
|
||||
(test-C c)
|
||||
(fA c)
|
||||
(fC c)
|
||||
|
||||
(define d (make <D>))
|
||||
(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 <A>
|
||||
|
||||
(define a2 (new-tA))
|
||||
(if (not (eq? (class-of a2) <A>))
|
||||
(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) <A>))
|
||||
(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) <A>))
|
||||
(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) <D>))
|
||||
(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) <D>))
|
||||
(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)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "constover.so")
|
||||
(include "../schemerunme/constover.scm")
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(load "contract.so")
|
||||
(include "testsuite.ss")
|
||||
(include "../schemerunme/contract.scm")
|
||||
|
|
@ -1,64 +0,0 @@
|
|||
(require 'cpp_basic)
|
||||
|
||||
(define-macro (check test)
|
||||
`(if (not ,test) (error "Error in test " ',test)))
|
||||
|
||||
(define f (make <Foo> 4))
|
||||
(check (= (slot-ref f 'num) 4))
|
||||
(slot-set! f 'num -17)
|
||||
(check (= (slot-ref f 'num) -17))
|
||||
|
||||
(define b (make <Bar>))
|
||||
|
||||
(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 <Foo> 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 <Foo> -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 <Foo> 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 <Foo> -7))
|
||||
(check (= (slot-ref (Bar-global-fref) 'num) -7))
|
||||
|
||||
(check (= (slot-ref (Bar-global-fval) 'num) 3))
|
||||
(Bar-global-fval (make <Foo> -34))
|
||||
(check (= (slot-ref (Bar-global-fval) 'num) -34))
|
||||
|
||||
;; Now test function pointers
|
||||
(define func1ptr (get-func1-ptr))
|
||||
(define func2ptr (get-func2-ptr))
|
||||
|
||||
(slot-set! f 'num 4)
|
||||
(check (= (func1 f 2) 16))
|
||||
(check (= (func2 f 2) -8))
|
||||
|
||||
(slot-set! f 'func-ptr func1ptr)
|
||||
(check (= (test-func-ptr f 2) 16))
|
||||
(slot-set! f 'func-ptr func2ptr)
|
||||
(check (= (test-func-ptr f 2) -8))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "cpp_enum.so")
|
||||
(include "../schemerunme/cpp_enum.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "cpp_namespace.so")
|
||||
(include "../schemerunme/cpp_namespace.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "dynamic_cast.so")
|
||||
(include "../schemerunme/dynamic_cast.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(require 'global_vars)
|
||||
(load "../schemerunme/global_vars.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(require 'global_vars)
|
||||
(load "../schemerunme/global_vars_proxy.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "import_nomodule.so")
|
||||
(include "../schemerunme/import_nomodule.scm")
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(load "imports_a.so")
|
||||
(load "imports_b.so")
|
||||
(include "../schemerunme/imports.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "inherit_missing.so")
|
||||
(include "../schemerunme/inherit_missing.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "li_std_string.so")
|
||||
(include "../schemerunme/li_std_string.scm")
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
(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 <Structure>))
|
||||
|
||||
;; MemberString should be a wrapped class
|
||||
(if (not (string=? (slot-ref struct 'MemberString) ""))
|
||||
(error "Error 4.5"))
|
||||
;(slot-set! (slot-ref struct 'MemberString) "and how")
|
||||
;;(if (not (string=? (slot-ref struct 'MemberString) "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)
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
(require 'li_typemaps)
|
||||
(load "../schemerunme/li_typemaps.scm")
|
||||
|
||||
(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
(lambda (a b)
|
||||
(if (not (and (= a 3) (= b -2)))
|
||||
(error "Error in inoutr-int2"))))
|
||||
(call-with-values (lambda () (out-foo 4))
|
||||
(lambda (a b)
|
||||
(if (not (and (= (Foo-a-get a) 4) (= b 8)))
|
||||
(error "Error in out-foo"))))
|
||||
(exit 0)
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
(require 'li_typemaps)
|
||||
(load "../schemerunme/li_typemaps_proxy.scm")
|
||||
|
||||
(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
(lambda (a b)
|
||||
(if (not (and (= a 3) (= b -2)))
|
||||
(error "Error in inoutr-int2"))))
|
||||
(call-with-values (lambda () (out-foo 4))
|
||||
(lambda (a b)
|
||||
(if (not (and (= (slot-ref a 'a) 4) (= b 8)))
|
||||
(error "Error in out-foo"))))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "list_vector.so")
|
||||
(include "../schemerunme/list_vector.scm")
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
(require 'member_pointer)
|
||||
|
||||
(define (check-eq? msg expected actual)
|
||||
(if (not (= expected actual))
|
||||
(error "Error " msg ": expected " expected " got " actual)))
|
||||
|
||||
(define area-pt (areapt))
|
||||
(define perim-pt (perimeterpt))
|
||||
|
||||
(define s (new-Square 10))
|
||||
|
||||
(check-eq? "Square area" 100.0 (do-op s area-pt))
|
||||
(check-eq? "Square perim" 40.0 (do-op s perim-pt))
|
||||
|
||||
(check-eq? "Square area" 100.0 (do-op s (areavar)))
|
||||
(check-eq? "Square perim" 40.0 (do-op s (perimetervar)))
|
||||
|
||||
;; Set areavar to return value of function
|
||||
(areavar perim-pt)
|
||||
(check-eq? "Square perim" 40 (do-op s (areavar)))
|
||||
|
||||
(check-eq? "Square area" 100.0 (do-op s (AREAPT)))
|
||||
(check-eq? "Square perim" 40.0 (do-op s (PERIMPT)))
|
||||
|
||||
(define test (NULLPT))
|
||||
|
||||
(perimetervar (AREAPT))
|
||||
(check-eq? "Square area" 100.0 (do-op s (perimetervar)))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(require 'multiple_inheritance)
|
||||
(load "../schemerunme/multiple_inheritance_proxy.scm")
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
;; this doesn't work yet :(
|
||||
(load "multivalue.so")
|
||||
(include "../schemerunme/multivalue.scm")
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "name.so")
|
||||
(include "../schemerunme/name.scm")
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
(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)
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
(load "newobject2.so")
|
||||
|
||||
(define f (new-Foo))
|
||||
|
||||
(Foo-dummy-set f 14)
|
||||
(if (not (= (Foo-dummy-get f) 14))
|
||||
(error "Bad dummy value"))
|
||||
|
||||
(if (not (= (fooCount) 0))
|
||||
(error "Bad foo count 1"))
|
||||
|
||||
(define f2 (makeFoo))
|
||||
|
||||
(if (not (= (fooCount) 1))
|
||||
(error "Bad foo count 2"))
|
||||
|
||||
(Foo-dummy-set f2 16)
|
||||
(if (not (= (Foo-dummy-get f2) 16))
|
||||
(error "Bad dummy value for f2"))
|
||||
|
||||
(set! f #f)
|
||||
(set! f2 #f)
|
||||
|
||||
(gc #t)
|
||||
|
||||
(if (not (= (fooCount) -1))
|
||||
(error "Bad foo count 3"))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
(load "newobject2.so")
|
||||
|
||||
(define f (make <Foo>))
|
||||
|
||||
(slot-set! f 'dummy 14)
|
||||
(if (not (= (slot-ref f 'dummy) 14))
|
||||
(error "Bad dummy value"))
|
||||
|
||||
(if (not (= (fooCount) 0))
|
||||
(error "Bad foo count 1"))
|
||||
|
||||
(define f2 (makeFoo))
|
||||
|
||||
(if (not (= (fooCount) 1))
|
||||
(error "Bad foo count 2"))
|
||||
|
||||
(slot-set! f2 'dummy 16)
|
||||
(if (not (= (slot-ref f2 'dummy) 16))
|
||||
(error "Bad dummy value for f2"))
|
||||
|
||||
(set! f #f)
|
||||
(set! f2 #f)
|
||||
|
||||
(gc #t)
|
||||
|
||||
(if (not (= (fooCount) -1))
|
||||
(error "Bad foo count 3"))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_complicated.so")
|
||||
(include "../schemerunme/overload_complicated.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_copy.so")
|
||||
(include "../schemerunme/overload_copy.scm")
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
(load "./overload_copy.so")
|
||||
|
||||
(define f (make <Foo>))
|
||||
(define g (make <Foo> f))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_extend_c.so")
|
||||
(include "../schemerunme/overload_extend_c.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_extend.so")
|
||||
(include "../schemerunme/overload_extend.scm")
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(load "./overload_extend.so")
|
||||
|
||||
(define f (make <Foo>))
|
||||
|
||||
(if (not (= (test f 3) 1))
|
||||
(error "test integer bad"))
|
||||
|
||||
(if (not (= (test f "hello") 2))
|
||||
(error "test string bad"))
|
||||
|
||||
(if (not (= (test f 3.5 2.5) 6.0))
|
||||
(error "test reals bad"))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_simple.so")
|
||||
(include "../schemerunme/overload_simple.scm")
|
||||
|
|
@ -1,56 +0,0 @@
|
|||
(load "overload_simple.so")
|
||||
|
||||
(define-macro (check test)
|
||||
`(if (not ,test) (error ',test)))
|
||||
|
||||
(check (string=? (foo) "foo:"))
|
||||
(check (string=? (foo 3) "foo:int"))
|
||||
(check (string=? (foo 3.01) "foo:double"))
|
||||
(check (string=? (foo "hey") "foo:char *"))
|
||||
|
||||
(define f (make <Foo>))
|
||||
(define b (make <Bar>))
|
||||
(define b2 (make <Bar> 3))
|
||||
|
||||
(check (= (slot-ref b 'num) 0))
|
||||
(check (= (slot-ref b2 'num) 3))
|
||||
|
||||
(check (string=? (foo f) "foo:Foo *"))
|
||||
(check (string=? (foo b) "foo:Bar *"))
|
||||
(check (string=? (foo f 3) "foo:Foo *,int"))
|
||||
(check (string=? (foo 3.2 b) "foo:double,Bar *"))
|
||||
|
||||
;; now check blah
|
||||
(check (string=? (blah 2.01) "blah:double"))
|
||||
(check (string=? (blah "hey") "blah:char *"))
|
||||
|
||||
;; now check spam member functions
|
||||
(define s (make <Spam>))
|
||||
(define s2 (make <Spam> 3))
|
||||
(define s3 (make <Spam> 3.2))
|
||||
(define s4 (make <Spam> "whee"))
|
||||
(define s5 (make <Spam> f))
|
||||
(define s6 (make <Spam> b))
|
||||
|
||||
(check (string=? (slot-ref s 'type) "none"))
|
||||
(check (string=? (slot-ref s2 'type) "int"))
|
||||
(check (string=? (slot-ref s3 'type) "double"))
|
||||
(check (string=? (slot-ref s4 'type) "char *"))
|
||||
(check (string=? (slot-ref s5 'type) "Foo *"))
|
||||
(check (string=? (slot-ref s6 'type) "Bar *"))
|
||||
|
||||
;; now check Spam member functions
|
||||
(check (string=? (foo s 2) "foo:int"))
|
||||
(check (string=? (foo s 2.1) "foo:double"))
|
||||
(check (string=? (foo s "hey") "foo:char *"))
|
||||
(check (string=? (foo s f) "foo:Foo *"))
|
||||
(check (string=? (foo s b) "foo:Bar *"))
|
||||
|
||||
;; check static member funcs
|
||||
(check (string=? (Spam-bar 3) "bar:int"))
|
||||
(check (string=? (Spam-bar 3.2) "bar:double"))
|
||||
(check (string=? (Spam-bar "hey") "bar:char *"))
|
||||
(check (string=? (Spam-bar f) "bar:Foo *"))
|
||||
(check (string=? (Spam-bar b) "bar:Bar *"))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "overload_subtype.so")
|
||||
(include "../schemerunme/overload_subtype.scm")
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
(load "./overload_subtype.so")
|
||||
|
||||
(define f (make <Foo>))
|
||||
(define b (make <Bar>))
|
||||
|
||||
(if (not (= (spam f) 1))
|
||||
(error "Error in foo"))
|
||||
|
||||
(if (not (= (spam b) 2))
|
||||
(error "Error in bar"))
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "pointer_in_out.so")
|
||||
(include "../schemerunme/pointer_in_out.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "reference_global_vars.so")
|
||||
(include "../schemerunme/reference_global_vars.scm")
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
(define (lookup-ext-tag tag)
|
||||
(cond
|
||||
((equal? tag '(quote swig-contract-assertion-failed))
|
||||
'( ((exn type) #f)) )
|
||||
(#t '())))
|
||||
|
||||
(define-macro (expect-throw tag-form form)
|
||||
`(if (condition-case (begin ,form #t)
|
||||
,@(lookup-ext-tag tag-form)
|
||||
((exn) (print "The form threw a different error than expected: " ',form) (exit 1))
|
||||
(var () (print "The form did not error as expected: " ',form) (exit 1)))
|
||||
(begin (print "The form returned normally when it was expected to throw an error: " ',form) (exit 1))))
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
(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)
|
||||
(print "Expression did not throw an error: " ',expr)))
|
||||
|
||||
(define f (new-Foo))
|
||||
|
||||
(check-throw (Foo-test-int f) (= exvar 37))
|
||||
(check-throw (Foo-test-msg f) (string=? exvar "Dead"))
|
||||
(check-throw (Foo-test-cls f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-cls-ptr f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-cls-ref f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-cls-td f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-cls-ptr-td f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-cls-ref-td f) (test-is-Error exvar))
|
||||
(check-throw (Foo-test-enum f) (= exvar (enum2)))
|
||||
|
||||
; don't know how to test this... it is returning a SWIG wrapped int *
|
||||
;(check-throw (Foo-test-array f) (equal? exvar '(0 1 2 3 4 5 6 7 8 9)))
|
||||
|
||||
(check-throw (Foo-test-multi f 1) (= exvar 37))
|
||||
(check-throw (Foo-test-multi f 2) (string=? exvar "Dead"))
|
||||
(check-throw (Foo-test-multi f 3) (test-is-Error exvar))
|
||||
|
||||
(set! f #f)
|
||||
(gc #t)
|
||||
|
||||
(exit 0)
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "typedef_inherit.so")
|
||||
(include "../schemerunme/typedef_inherit.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "typename.so")
|
||||
(include "../schemerunme/typename.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "unions.so")
|
||||
(include "../schemerunme/unions.scm")
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(load "unions.so")
|
||||
(include "../schemerunme/unions_proxy.scm")
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
%module chicken_ext_test
|
||||
|
||||
/* just use the imports_a.h header... for this test we only need a class */
|
||||
%{
|
||||
#include "imports_a.h"
|
||||
%}
|
||||
|
||||
%include "imports_a.h"
|
||||
|
||||
%{
|
||||
void test_create(C_word,C_word,C_word) C_noret;
|
||||
%}
|
||||
|
||||
%init %{
|
||||
{
|
||||
C_word *space = C_alloc(2 + C_SIZEOF_INTERNED_SYMBOL(11));
|
||||
sym = C_intern (&space, 11, "test-create");
|
||||
C_mutate ((C_word*)sym+1, (*space=C_CLOSURE_TYPE|1, space[1]=(C_word)test_create, tmp=(C_word)space, space+=2, tmp));
|
||||
}
|
||||
%}
|
||||
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
/* This is a basic test of proxy classes, used by chicken */
|
||||
/* This is a basic test of proxy classes */
|
||||
|
||||
%warnfilter(SWIGWARN_TYPEMAP_SWIGTYPELEAK); /* memory leak when setting a ptr/ref variable */
|
||||
|
||||
|
|
|
|||
|
|
@ -30,8 +30,6 @@ class ex2 : public myException
|
|||
|
||||
#if !defined(SWIGUTL)
|
||||
|
||||
#if !defined(SWIGCHICKEN)
|
||||
|
||||
%inline %{
|
||||
class Impl
|
||||
{
|
||||
|
|
@ -41,10 +39,6 @@ class Impl
|
|||
};
|
||||
%}
|
||||
|
||||
#else
|
||||
#warning "Chicken needs fixing for partial exception information"
|
||||
#endif
|
||||
|
||||
#else
|
||||
#warning "UTL needs fixing for partial exception information"
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -2,10 +2,6 @@
|
|||
// Based on overload_simple testcase
|
||||
%module overload_arrays
|
||||
|
||||
#ifdef SWIGCHICKEN
|
||||
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
|
||||
#endif
|
||||
|
||||
#ifdef SWIGLUA
|
||||
// lua only has one numeric type, so most of the overloads shadow each other creating warnings
|
||||
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,6 @@
|
|||
// Simple tests of overloaded functions
|
||||
%module overload_simple
|
||||
|
||||
#ifdef SWIGCHICKEN
|
||||
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) fbool;
|
||||
#endif
|
||||
|
||||
#ifdef SWIGLUA
|
||||
// lua only has one numeric type, so most of the overloads shadow each other creating warnings
|
||||
%warnfilter(SWIGWARN_LANG_OVERLOAD_SHADOW) foo;
|
||||
|
|
|
|||
|
|
@ -298,11 +298,6 @@ inline const char* mangle_macro ## #@__VA_ARGS__ () {
|
|||
/* chiao */
|
||||
#endif;
|
||||
|
||||
#ifdef SWIGCHICKEN
|
||||
/* define is a scheme keyword (and thus an invalid variable name), so SWIG warns about it */
|
||||
%warnfilter(SWIGWARN_PARSE_KEYWORD) define;
|
||||
#endif
|
||||
|
||||
#ifdef SWIGRUBY
|
||||
%rename(ddefined) defined;
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -24,8 +24,8 @@
|
|||
;(check "ulonglong" 6432 =)
|
||||
|
||||
;; The checking of inoutr-int2 and out-foo is done in the individual
|
||||
;; language runme scripts, since chicken returns multiple values
|
||||
;; and must be checked with call-with-values, while guile just returns a list
|
||||
;; language runme scripts, since how multiple values are returned
|
||||
;; differs between scheme variants.
|
||||
|
||||
;(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
; (lambda (a b)
|
||||
|
|
|
|||
|
|
@ -24,8 +24,8 @@
|
|||
(check "ulonglong" 6432 =)
|
||||
|
||||
;; The checking of inoutr-int2 and out-foo is done in the individual
|
||||
;; language runme scripts, since chicken returns multiple values
|
||||
;; and must be checked with call-with-values, while guile just returns a list
|
||||
;; language runme scripts, since how multiple values are returned
|
||||
;; differs between scheme variants.
|
||||
|
||||
;(call-with-values (lambda () (inoutr-int2 3 -2))
|
||||
; (lambda (a b)
|
||||
|
|
|
|||
|
|
@ -3,9 +3,7 @@
|
|||
#include <vector>
|
||||
%}
|
||||
|
||||
#ifndef SWIGCHICKEN
|
||||
%include "std_common.i"
|
||||
#endif
|
||||
|
||||
%inline
|
||||
{
|
||||
|
|
|
|||
|
|
@ -196,7 +196,6 @@ namespace ns1 {
|
|||
%}
|
||||
|
||||
|
||||
#ifndef SWIGCHICKEN
|
||||
%include std_vector.i
|
||||
|
||||
%{
|
||||
|
|
@ -211,6 +210,3 @@ void q(double = 0) {}
|
|||
|
||||
%constant void (*Bf)(std::vector<double> *p = 0) = g;
|
||||
%constant void (*Cf)(double = 0) = q;
|
||||
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue