The great merge

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

SWIG/Examples/test-suite/ocaml/Makefile

@@ -0,0 +1,64 @@
+LANGUAGE     = ocaml
+VARIANT      = _static
+SCRIPTSUFFIX = _runme.ml
+
+C_TEST_CASES = 
+
+run_testcase = \
+	if [ -f $*\_runme.ml ] ; then \
+		(ocamlc -c $*\_runme.ml ; \
+		ocamlc -custom -g -o runme $*\.cmo $*\_runme.cmo $*\_wrap.o ; \
+		./runme) ; \
+	fi ; 
+
+check_quant:
+	cat /dev/null > testing
+	cat /dev/null > success
+	cat /dev/null > results
+	$(MAKE) check
+	echo "Failed:" >> results
+	for element in `cat testing` ; do \
+		if grep $$element success >/dev/null 2>/dev/null ; then \
+			: ; \
+		else \
+			echo $$element >> results ; \
+		fi ; \
+	done
+	echo "Success:" >> results
+	cat success >> results
+
+include ../common.mk
+
+%.cpptest:
+	echo $@ >> testing
+	$(setup) \
+	($(swig_and_compile_cpp); ) ; \
+	$(run_testcase) \
+	if [ -f $(@:%.cpptest=%_wrap.o) ] ; then \
+		echo $@ >> success ; \
+	fi
+
+%.ctest:
+	echo $@ >> testing
+	$(setup) \
+	($(swig_and_compile_c); ) ; \
+	$(run_testcase) \
+	if [ -f $(@:%.ctest=%_wrap.o) ] ; then \
+		echo $@ >> success ; \
+	fi
+
+%.multicpptest:
+	echo $@ >> testing
+	$(setup) \
+	($(swig_and_compile_multi_cpp); ) ; \
+	$(run_testcase) \
+	if [ -f $(@:%.multicpptest=%_a_wrap.o) ] ; then \
+		echo $@ >> success ; \
+	fi
+
+%.clean:
+	@rm -f $*.ml $*.mli;
+
+clean:
+	$(MAKE) -f $(TOP)/Makefile ocaml_clean
+

SWIG/Examples/test-suite/ocaml/README

@@ -0,0 +1,2 @@
+I stole most of these runme's from the ruby runme scripts, since the current
+ocaml interface mirrors the ruby interface in many ways.

SWIG/Examples/test-suite/ocaml/class_ignore_runme.ml

@@ -0,0 +1,6 @@
+open Class_ignore
+
+let a = new_Bar C_void
+let _ = (if _do_blah a <> C_string "Bar::blah" then
+  raise (Failure "We didn't really get a bar object."))
+

SWIG/Examples/test-suite/ocaml/makedebugtop

@@ -0,0 +1,21 @@
+#!/bin/sh
+#
+# Usage: makedebugtop test_name.c[pp]test
+#
+# Creates an ocaml toplevel for debugging based on a .cpptest or .ctest
+# file.
+#
+
+OCAMLINC=/usr/local/lib/ocaml
+swigtest=$1
+thetest=`echo $1 | sed -e 's/\.c[p]*test//g'`
+cppopt=""
+if echo $swigtest | grep -s cpptest ; then
+	cppopt=-xc++
+fi
+
+echo "Making the test"
+make $swigtest
+echo "Building ${thetest}_top"
+gcc -c -g $cppopt -I$OCAMLINC ${thetest}_wrap.c
+ocamlmktop -cclib -g -custom ${thetest}_wrap.o ${thetest}.cmo -o ${thetest}_top

SWIG/Examples/test-suite/ocaml/newobject1_runme.ml

@@ -0,0 +1,25 @@
+open Newobject1
+
+exception RuntimeError of string * int
+
+let foo1 = ref (_Foo_makeFoo C_void)
+let _ = if get_int (_Foo_fooCount C_void) != 1 then
+   raise (RuntimeError ("(1) Foo.fooCount != 1",
+			get_int (_Foo_fooCount C_void)))
+
+let foo2 = ref ((invoke !foo1) "makeMore" C_void) 
+let _ = if get_int (_Foo_fooCount C_void) != 2 then
+   raise (RuntimeError ("(2) Foo.fooCount != 2",
+			get_int (_Foo_fooCount C_void)))
+
+let _ = begin
+  foo1 := C_void ; Gc.full_major () ;
+  (if get_int (_Foo_fooCount C_void) != 1 then
+	raise (RuntimeError ("(3) Foo.fooCount != 1",
+			     get_int (_Foo_fooCount C_void)))) ;
+
+  foo2 := C_void ; Gc.full_major () ;
+  (if get_int (_Foo_fooCount C_void) != 0 then
+	raise (RuntimeError ("(4) Foo.fooCount != 0",
+			     get_int (_Foo_fooCount C_void)))) ;
+end

SWIG/Examples/test-suite/ocaml/overload_copy_runme.ml

@@ -0,0 +1,4 @@
+open Overload_copy
+
+let f = new_Foo C_void 
+let g = new_Foo f 

SWIG/Examples/test-suite/ocaml/results

@@ -0,0 +1,180 @@
+Failed:
+template_typedef_import.multicpptest
+Success:
+template_specialization.cpptest
+default_cast.cpptest
+import_nomodule.cpptest
+struct_value.cpptest
+abstract_inherit.cpptest
+abstract_inherit_ok.cpptest
+add_link.cpptest
+anonymous_arg.cpptest
+argout.cpptest
+arrays_global.cpptest
+arrays_global_twodim.cpptest
+arrays_scope.cpptest
+bool_default.cpptest
+casts.cpptest
+class_ignore.cpptest
+const_const_2.cpptest
+constant_pointers.cpptest
+constover.cpptest
+constructor_exception.cpptest
+constructor_explicit.cpptest
+constructor_value.cpptest
+conversion.cpptest
+conversion_namespace.cpptest
+conversion_ns_template.cpptest
+cplusplus_throw.cpptest
+cpp_enum.cpptest
+cpp_enum_scope.cpptest
+cpp_namespace.cpptest
+cpp_nodefault.cpptest
+cpp_static.cpptest
+cpp_typedef.cpptest
+default_constructor.cpptest
+default_ns.cpptest
+default_ref.cpptest
+dynamic_cast.cpptest
+enum_scope.cpptest
+enum_scope_template.cpptest
+enum_var.cpptest
+evil_diamond.cpptest
+evil_diamond_ns.cpptest
+evil_diamond_prop.cpptest
+explicit.cpptest
+extend_template.cpptest
+extend_template_ns.cpptest
+grouping.cpptest
+ignore_parameter.cpptest
+inherit_missing.cpptest
+kind.cpptest
+lib_carrays.cpptest
+lib_cdata.cpptest
+lib_cpointer.cpptest
+lib_std_deque.cpptest
+lib_std_string.cpptest
+lib_std_vector.cpptest
+lib_typemaps.cpptest
+member_template.cpptest
+minherit.cpptest
+name_cxx.cpptest
+name_inherit.cpptest
+namespace_enum.cpptest
+namespace_extend.cpptest
+namespace_template.cpptest
+namespace_typemap.cpptest
+newobject1.cpptest
+overload_complicated.cpptest
+overload_copy.cpptest
+overload_extend.cpptest
+overload_simple.cpptest
+overload_subtype.cpptest
+overload_template.cpptest
+pointer_reference.cpptest
+primitive_ref.cpptest
+private_assign.cpptest
+pure_virtual.cpptest
+rename_default.cpptest
+rename_scope.cpptest
+return_value_scope.cpptest
+rname.cpptest
+smart_pointer_const.cpptest
+smart_pointer_multi.cpptest
+smart_pointer_multi_typedef.cpptest
+smart_pointer_not.cpptest
+smart_pointer_overload.cpptest
+smart_pointer_protected.cpptest
+smart_pointer_rename.cpptest
+smart_pointer_simple.cpptest
+smart_pointer_typedef.cpptest
+static_array_member.cpptest
+static_const_member.cpptest
+static_const_member_2.cpptest
+template.cpptest
+template_arg_scope.cpptest
+template_arg_typename.cpptest
+template_base_template.cpptest
+template_classes.cpptest
+template_const_ref.cpptest
+template_construct.cpptest
+template_default.cpptest
+template_default2.cpptest
+template_default_inherit.cpptest
+template_default_qualify.cpptest
+template_enum.cpptest
+template_enum_ns_inherit.cpptest
+template_enum_typedef.cpptest
+template_forward.cpptest
+template_inherit.cpptest
+template_inherit_abstract.cpptest
+template_int_const.cpptest
+template_ns.cpptest
+template_ns2.cpptest
+template_ns3.cpptest
+template_ns4.cpptest
+template_ns_enum.cpptest
+template_ns_enum2.cpptest
+template_ns_inherit.cpptest
+template_ns_scope.cpptest
+template_qualifier.cpptest
+template_rename.cpptest
+template_retvalue.cpptest
+template_static.cpptest
+template_tbase_template.cpptest
+template_type_namespace.cpptest
+template_typedef.cpptest
+template_typedef_cplx.cpptest
+template_typedef_cplx2.cpptest
+template_typedef_cplx3.cpptest
+template_typedef_cplx4.cpptest
+template_virtual.cpptest
+template_whitespace.cpptest
+throw_exception.cpptest
+typedef_funcptr.cpptest
+typedef_inherit.cpptest
+typedef_mptr.cpptest
+typedef_reference.cpptest
+typedef_scope.cpptest
+typemap_namespace.cpptest
+typemap_ns_using.cpptest
+typename.cpptest
+union_scope.cpptest
+using1.cpptest
+using2.cpptest
+using_composition.cpptest
+using_extend.cpptest
+using_inherit.cpptest
+using_private.cpptest
+using_protected.cpptest
+valuewrapper_base.cpptest
+virtual_destructor.cpptest
+voidtest.cpptest
+arrayptr.ctest
+arrays.ctest
+char_constant.ctest
+const_const.ctest
+defineop.ctest
+defines.ctest
+enum.ctest
+lib_carrays.ctest
+lib_cdata.ctest
+lib_cmalloc.ctest
+lib_constraints.ctest
+lib_cpointer.ctest
+lib_math.ctest
+long_long.ctest
+macro_2.ctest
+name.ctest
+nested.ctest
+newobject2.ctest
+overload_extendc.ctest
+preproc_1.ctest
+preproc_2.ctest
+preproc_3.ctest
+ret_by_value.ctest
+sizeof_pointer.ctest
+sneaky1.ctest
+typemap_subst.ctest
+unions.ctest
+imports.multicpptest

SWIG/Examples/test-suite/ocaml/sneaky1_runme.ml

@@ -0,0 +1,8 @@
+(* Stolen from ruby test cases *)
+
+open Sneaky1
+
+let x = Sneaky1._add (C_list [ C_int 3; C_int 4 ])
+let y = Sneaky1._sub (C_list [ C_int 3; C_int 4 ])
+let z = Sneaky1._mul (C_list [ C_int 3; C_int 4 ])
+let w = Sneaky1._divide (C_list [ C_int 3; C_int 4 ])

SWIG/Examples/test-suite/ocaml/throw_exception_runme.ml

@@ -0,0 +1,27 @@
+(* Throw exception test *)
+
+open Throw_exception
+
+let x = new_Foo C_void ;;
+let _ =
+  try
+    (invoke x) "test_int" C_void 
+  with (Failure "Exception(37): Thrown exception from C++ (int)\n") ->
+  try 
+    (invoke x) "test_msg" C_void
+  with (Failure "Exception(0): Dead\n") ->
+  try
+    (invoke x) "test_cls" C_void 
+  with (Failure "Exception(0): Thrown exception from C++ (unknown)\n") ->
+  try
+    (invoke x) "test_multi" (C_int 1)
+  with (Failure "Exception(37): Thrown exception from C++ (int)\n") ->
+  try
+    (invoke x) "test_multi" (C_int 2)
+  with (Failure "Exception(0): Dead\n") ->
+  try
+    (invoke x) "test_multi" (C_int 3)
+  with (Failure "Exception(0): Thrown exception from C++ (unknown)\n") ->
+    exit 0
+
+let _ = exit 1

SWIG/Examples/test-suite/ocaml/typename_runme.ml

@@ -0,0 +1,11 @@
+(* Fun with type names -- stolen from the ruby runme *)
+
+open Typename
+
+let f = new_Foo C_void 
+let b = new_Bar C_void
+
+let x = _twoFoo f 
+let _ = match x with C_double f -> () | _ -> raise (Failure "not a float")
+let y = _twoBar b
+let _ = match y with C_int i -> () | _ -> raise (Failure "not an int")

SWIG/Examples/test-suite/ocaml/unions_runme.ml

@@ -0,0 +1,27 @@
+(* Test the unions example... *)
+
+open Unions 
+
+let a = new_SmallStruct C_void
+let b = new_BigStruct C_void
+let c = new_UnionTest C_void
+let d = new_EmbeddedUnionTest C_void 
+
+let _ = (invoke a) "jill_set" (C_short 3)
+let _ = (invoke b) "jack_set" (C_char 'a')  (* Int conversion *)
+let _ = (invoke b) "smallstruct_set" a      (* Put a in b *)
+let _ = (invoke c) "bs_set" b
+
+let _ = if get_int ((invoke a) "jill_get" C_void) != 3 then
+	raise (Failure "jill value is not preserved")
+let _ = if get_int ((invoke b) "jack_get" C_void) != (int_of_char 'a') then
+	raise (Failure "jack value is not preserved")
+let _ = if get_int ((invoke ((invoke b) "smallstruct_get" C_void))
+	"jill_get" C_void) != 3 then
+	raise (Failure "jill value is not embedded in bigstruct")
+let _ = if get_int ((invoke ((invoke c) "bs_get" C_void))
+	"jack_get" C_void) != (int_of_char 'a') then
+	raise (Failure "union set of bigstruct did not take")
+let _ = if get_int ((invoke ((invoke c) "ss_get" C_void))
+	"jill_get" C_void) != (int_of_char 'a') then
+	raise (Failure "corresponding union values are not the same")