- Fix SF bug 1573892

- Minor change to chicken to make it work with version 2.5rc1
- add externaltest to chicken and guile modules


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

CHANGES.current

@@ -1,6 +1,17 @@
 Version 1.3.30 (in progress)
 ============================
 
+10/14/2006: wuzzeb (John Lenz)
+	    [Chicken] Minor fix to make SWIG work with the (as yet unreleased) chicken 2.5
+
+	    [Guile,Chicken] Fix SF Bug 1573892.  Added an ext_test to the test suite to test
+	    this bug, but this test can not really be made generic because the external code must
+	    plug into the target language interpreter directly.
+	    See Examples/test-suite/chicken/ext_test.i and ext_test_external.cxx
+
+	    Added a %.externaltest to common.mk, and any interested language modules can
+	    copy and slightly modify either the chicken or the guile ext_test.i
+
 10/14/2006: mgossage
             [Lua] added OUTPUT& for all number types, added a long long type
             fixed several test cases.

Examples/Makefile.in

@@ -296,6 +296,9 @@ guile_cpp: $(SRCS)
 	$(CXX) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(GUILE_INCLUDE) $(ICXXSRCS) $(SRCS) $(CXXSRCS)
 	$(CXXSHARED) $(CFLAGS) $(OBJS) $(IOBJS) $(LIBS) $(CPP_DLLIBS) -o $(GUILE_LIBPREFIX)$(TARGET)$(GUILE_SO)
 
+guile_externalhdr:
+	$(SWIG) -guile -external-runtime $(TARGET)
+
 #------------------------------------------------------------------
 # Build a dynamically loaded module with passive linkage and the gh interface
 #------------------------------------------------------------------
@@ -839,6 +842,9 @@ chicken_cpp:
 	$(SWIG) -c++ -chicken $(SWIGOPT) $(INCLUDE) $(INTERFACE)
 	$(CHICKEN_CSC) -s `echo $(INCLUDES) | sed 's/-I/-C -I/g'` $(CHICKEN_GENERATED_SCHEME) $(SRCS) $(ICXXSRCS) $(CXXSRCS) -o $(TARGET)$(SO)
 
+chicken_externalhdr:
+	$(SWIG) -chicken -external-runtime $(TARGET)
+
 chicken_clean:
 	rm -f *_wrap* *~ .~* *_chicken*
 	rm -f core @EXTRA_CLEAN@

Examples/test-suite/chicken/Makefile.in

@@ -20,6 +20,8 @@ SKIP_CPP_STD_CASES = Yes
 
 CPP_TEST_CASES += li_std_string 
 
+EXTRA_TEST_CASES += ext_test.externaltest
+
 include $(srcdir)/../common.mk
 
 
@@ -51,6 +53,11 @@ SWIGOPT += -nounit
 	  $(MAKE) $*.multiproxy; ) \
 	fi;
 
+%.externaltest:
+	$(setup) \
+	($(swig_and_compile_external); ) && \
+	$(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 = \

Examples/test-suite/chicken/ext_test.i

@@ -0,0 +1,21 @@
+%module 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));
+ }
+%}
+

Examples/test-suite/chicken/ext_test_external.cxx

@@ -0,0 +1,22 @@
+#include <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);
+}
+

Examples/test-suite/chicken/ext_test_runme.ss

@@ -0,0 +1,5 @@
+(load "ext_test.so")
+
+(define a (test-create))
+
+(A-hello a)

Examples/test-suite/common.mk

@@ -404,7 +404,8 @@ MULTI_CPP_TEST_CASES += \
 NOT_BROKEN_TEST_CASES =	$(CPP_TEST_CASES:=.cpptest) \
 			$(C_TEST_CASES:=.ctest) \
 			$(MULTI_CPP_TEST_CASES:=.multicpptest) \
-			$(CUSTOM_TEST_CASES:=.customtest)
+			$(CUSTOM_TEST_CASES:=.customtest) \
+			$(EXTRA_TEST_CASES)
 
 BROKEN_TEST_CASES = 	$(CPP_TEST_BROKEN:=.cpptest) \
 			$(C_TEST_BROKEN:=.ctest)
@@ -448,6 +449,17 @@ swig_and_compile_multi_cpp = \
 	  $(LANGUAGE)$(VARIANT)_cpp; \
 	done
 
+swig_and_compile_external =  \
+	$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile \
+	SWIG_LIB="$(SWIG_LIB)" SWIG="$(SWIG)" \
+	TARGET="$*_wrap_hdr.h" \
+	$(LANGUAGE)$(VARIANT)_externalhdr; \
+	$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile CXXSRCS="$(CXXSRCS) $*_external.cxx" \
+	SWIG_LIB="$(SWIG_LIB)" SWIG="$(SWIG)" \
+	INCLUDES="$(INCLUDES)" SWIGOPT="$(SWIGOPT)" NOLINK=true \
+	TARGET="$(TARGETPREFIX)$*$(TARGETSUFFIX)" INTERFACE="$*.i" \
+	$(LANGUAGE)$(VARIANT)_cpp
+
 swig_and_compile_runtime = \
 
 setup = \

Examples/test-suite/guilescm/Makefile.in

@@ -3,8 +3,12 @@
 # Makefile for guile test-suite (with SCM API)
 #######################################################################
 
+EXTRA_TEST_CASES += ext_test.externaltest
+
 include ../guile/Makefile
 
+INCLUDES += -I$(top_srcdir)/$(EXAMPLES)/$(TEST_SUITE)/guilescm
+
 VARIANT      =
 # Refer to the guile directory for the run scripts
 SCRIPTPREFIX = ../guile/
@@ -31,3 +35,21 @@ swig_and_compile_multi_cpp = \
 	  TARGET="$(TARGETPREFIX)$${f}$(TARGETSUFFIX)" INTERFACE="$$f.i" \
 	  $(LANGUAGE)$(VARIANT)_cpp; \
 	done
+
+%.externaltest:
+	$(local_setup) \
+	($(swig_and_compile_external); ) && \
+	$(local_run_testcase)
+	
+# Same as setup and run_testcase, but without the SCRIPTPREFIX (so the runme comes from the guilescm directory)
+local_setup = \
+	if [ -f $(srcdir)/$*$(SCRIPTSUFFIX) ]; then	  \
+	  echo "Checking testcase $* (with run test) under $(LANGUAGE) (with SCM API)" ; \
+	else								  \
+	  echo "Checking testcase $* under $(LANGUAGE) (with SCM API)" ;		  \
+	fi;
+
+local_run_testcase = \
+	if [ -f $(srcdir)/$*$(SCRIPTSUFFIX) ]; then (	  \
+	  env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(GUILE) -l $(srcdir)/$*$(SCRIPTSUFFIX);) \
+	fi;

Examples/test-suite/guilescm/ext_test.i

@@ -0,0 +1,19 @@
+%module 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"
+
+%{
+SCM test_create();
+SCM test_is_pointer(SCM val);
+%}
+
+%init %{
+  scm_c_define_gsubr("test-create", 0, 0, 0, (swig_guile_proc) test_create);
+  scm_c_define_gsubr("test-is-pointer", 1, 0, 0, (swig_guile_proc) test_is_pointer);
+%}
+

Examples/test-suite/guilescm/ext_test_external.cxx

@@ -0,0 +1,24 @@
+#include <ext_test_wrap_hdr.h>
+#include <imports_a.h>
+
+SCM test_create()
+{
+#define FUNC_NAME "test-create"
+  SCM result;
+  A *newobj;
+  swig_type_info *type;
+  
+  newobj = new A();
+  type = SWIG_TypeQuery("A *");
+  result = SWIG_NewPointerObj(result, type, 1);
+  
+  return result;
+#undef FUNC_NAME
+}
+
+SCM test_is_pointer(SCM val)
+{
+#define FUNC_NAME "test-is-pointer"
+  return SCM_BOOL(SWIG_IsPointer(val));
+#undef FUNC_NAME
+}

Examples/test-suite/guilescm/ext_test_runme.scm

@@ -0,0 +1,19 @@
+(dynamic-call "scm_init_ext_test_module" (dynamic-link "./libext_test.so"))
+
+; This is a test for SF Bug 1573892
+; If IsPointer is called before TypeQuery, the test-is-pointer will fail
+; (i.e if the bottom two lines were moved to the top, the old code would succeed)
+; only a problem when is-pointer is called first
+
+(define a (new-A))
+
+(if (not (test-is-pointer a))
+  (error "test-is-pointer failed!"))
+
+(if (test-is-pointer 5)
+  (error "test-is-pointer thinks 5 is a pointer!"))
+
+(define b (test-create))
+(A-hello b)
+
+(exit 0)

Lib/guile/guile_scm_run.swg

@@ -53,6 +53,7 @@ typedef struct swig_guile_clientdata {
 #define SWIG_NewMemberObj(ptr, sz, type)                SWIG_Guile_NewMemberObj(ptr, sz, type, FUNC_NAME)
   
 /* Runtime API */
+static swig_module_info *SWIG_Guile_GetModule();
 #define SWIG_GetModule(clientdata) SWIG_Guile_GetModule()
 #define SWIG_SetModule(clientdata, pointer) SWIG_Guile_SetModule(pointer)
   
@@ -200,6 +201,8 @@ SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type)
 static SWIGINLINE int
 SWIG_Guile_IsPointer (SCM s)
 {
+  /* module might not be initialized yet, so initialize it */
+  SWIG_Guile_GetModule();
   return SWIG_Guile_IsPointerOfType (s, NULL);
 }
 

Source/Modules/chicken.cxx

@@ -276,7 +276,9 @@ CHICKEN::top(Node *n)
   Printv(f_scm,"(define swig-init-return (swig-init))\n\n", NIL);
 
   if (clos) {
-    Printf (f_scm, "(declare (uses tinyclos))\n");
+    //Printf (f_scm, "(declare (uses tinyclos))\n");
+    //New chicken versions have tinyclos as an egg
+    Printf(f_scm, "(require-extension tinyclos)\n");
     Replaceall(closprefix,"$module", scmmodule);
     Printf (f_scm, "%s\n", closprefix);
     Printf (f_scm, "%s\n", clos_class_defines);