From: Clemens Lang Date: Sat, 30 May 2015 13:29:43 +0000 (+0200) Subject: Implement libsolv Tcl bindings X-Git-Tag: 0.6.12~51^2~3 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=53e56af625ce5479579a81c30957ec32deebd1f7;p=thirdparty%2Flibsolv.git Implement libsolv Tcl bindings Add the necessary build system changes and modifications in the SIWG interface definition file to enable generation of Tcl bindings. The build system generates and installs a Tcl module that can used from tclsh using % package require solv Constants and operations are available in the solv:: namespace, e.g. % puts $solv::Solver_POLICY_ILLEGAL_DOWNGRADE will echo "1". Rudimentary testing has been done, but this should be considered experimental for now. We will fix problems as we encounter them. Signed-off-by: Clemens Lang --- diff --git a/CMakeLists.txt b/CMakeLists.txt index 45422af4..c42e1a31 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,6 +8,7 @@ OPTION (DISABLE_SHARED "Do not build a shared version of the libraries?" OFF) OPTION (ENABLE_PERL "Build the perl bindings?" OFF) OPTION (ENABLE_PYTHON "Build the python bindings?" OFF) OPTION (ENABLE_RUBY "Build the ruby bindings?" OFF) +OPTION (ENABLE_TCL "Build the Tcl bindings?" OFF) OPTION (USE_VENDORDIRS "Install the bindings in vendor directories?" OFF) @@ -332,9 +333,9 @@ ENDIF (HAVE_LINKER_AS_NEEDED) ADD_SUBDIRECTORY (src) ADD_SUBDIRECTORY (ext) ADD_SUBDIRECTORY (tools) -IF (ENABLE_PERL OR ENABLE_PYTHON OR ENABLE_RUBY) +IF (ENABLE_PERL OR ENABLE_PYTHON OR ENABLE_RUBY OR ENABLE_TCL) ADD_SUBDIRECTORY (bindings) -ENDIF (ENABLE_PERL OR ENABLE_PYTHON OR ENABLE_RUBY) +ENDIF (ENABLE_PERL OR ENABLE_PYTHON OR ENABLE_RUBY OR ENABLE_TCL) ADD_SUBDIRECTORY (examples) ADD_SUBDIRECTORY (doc) diff --git a/bindings/CMakeLists.txt b/bindings/CMakeLists.txt index 90007730..34b07846 100644 --- a/bindings/CMakeLists.txt +++ b/bindings/CMakeLists.txt @@ -14,3 +14,6 @@ ENDIF (ENABLE_PERL) IF (ENABLE_RUBY) ADD_SUBDIRECTORY (ruby) ENDIF (ENABLE_RUBY) +IF (ENABLE_TCL) + ADD_SUBDIRECTORY (tcl) +ENDIF (ENABLE_TCL) diff --git a/bindings/solv.i b/bindings/solv.i index 40307964..601a3204 100644 --- a/bindings/solv.i +++ b/bindings/solv.i @@ -49,6 +49,8 @@ typedef struct { %typemap(out,noblock=1,fragment="SWIG_FromCharPtrAndSize") BinaryBlob { #if defined(SWIGPYTHON) && defined(PYTHON3) $result = $1.data ? Py_BuildValue("y#", $1.data, $1.len) : SWIG_Py_Void(); +#elif defined(SWIGTCL) + Tcl_SetObjResult(interp, SWIG_FromCharPtrAndSize($1.data, $1.len)); #else $result = SWIG_FromCharPtrAndSize($1.data, $1.len); #if defined(SWIGPERL) @@ -228,7 +230,80 @@ typedef struct { %enddef #endif +#if defined(SWIGTCL) +%typemap(in) Queue { + /* Check if is a list */ + int retval = TCL_OK; + int size = 0; + int i = 0; + + if (TCL_OK != (retval = Tcl_ListObjLength(interp, $input, &size))) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("argument is not a list", -1)); + return retval; + } + + queue_init(&$1); + + for (i = 0; i < size; i++) { + Tcl_Obj *o = NULL; + int v; + + if (TCL_OK != (retval = Tcl_ListObjIndex(interp, $input, i, &o))) { + queue_free(&$1); + Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to retrieve a list member", -1)); + return retval; + } + + int e = SWIG_AsVal_int SWIG_TCL_CALL_ARGS_2(o, &v); + if (!SWIG_IsOK(e)) { + queue_free(&$1); + SWIG_exception_fail(SWIG_ArgError(e), "list must contain only integers"); + return TCL_ERROR; + } + + queue_push(&$1, v); + } +} + +%typemap(out) Queue { + Tcl_Obj *objvx[$1.count]; + int i; + + for (i = 0; i < $1.count; i++) { + objvx[i] = SWIG_From_int($1.elements[i]); + } + + Tcl_SetObjResult(interp, Tcl_NewListObj($1.count, objvx)); + + queue_free(&$1); +} + +%define Queue2Array(type, step, con) %{ + { /* scope is needed to make the goto of SWIG_exception_fail work */ + int i; + int cnt = $1.count / step; + Id *idp = $1.elements; + Tcl_Obj *objvx[cnt]; + + for (i = 0; i < cnt; i++, idp += step) { + Id id = *idp; +#define result resultx +#define Tcl_SetObjResult(i, x) resultobj = x + type result = con; + Tcl_Obj *resultobj; + $typemap(out, type) + objvx[i] = resultobj; +#undef Tcl_SetObjResult +#undef result + } + queue_free(&$1); + Tcl_SetObjResult(interp, Tcl_NewListObj(cnt, objvx)); + } +%} +%enddef + +#endif #if defined(SWIGPERL) @@ -357,6 +432,11 @@ typedef VALUE AppObjectPtr; %typemap(out) AppObjectPtr { $result = (VALUE)$1; } +#elif defined(SWIGTCL) +typedef TclObj *AppObjectPtr; +%typemap(out) AppObjectPtr { + Tcl_SetObjResult(interp, $1 ? $1 : Tcl_NewObj()); +} #endif @@ -372,6 +452,8 @@ typedef VALUE AppObjectPtr; SWIGINTERN int #ifdef SWIGRUBY SWIG_AsValSolvFpPtr(VALUE obj, FILE **val) { +#elif defined(SWIGTCL) +SWIG_AsValSolvFpPtr SWIG_TCL_DECL_ARGS_2(void *obj, FILE **val) { #else SWIG_AsValSolvFpPtr(void *obj, FILE **val) { #endif @@ -393,6 +475,10 @@ SWIG_AsValSolvFpPtr(void *obj, FILE **val) { return SWIG_TypeError; } +#if defined(SWIGTCL) +#define SWIG_AsValSolvFpPtr(x, y) SWIG_AsValSolvFpPtr SWIG_TCL_CALL_ARGS_2(x, y) +#endif + } @@ -401,6 +487,8 @@ SWIG_AsValSolvFpPtr(void *obj, FILE **val) { SWIGINTERN int #ifdef SWIGRUBY SWIG_AsValDepId(VALUE obj, int *val) { +#elif defined(SWIGTCL) +SWIG_AsValDepId SWIG_TCL_DECL_ARGS_2(void *obj, int *val) { #else SWIG_AsValDepId(void *obj, int *val) { #endif @@ -408,7 +496,11 @@ SWIG_AsValDepId(void *obj, int *val) { void *vptr = 0; int ecode; if (!desc) desc = SWIG_TypeQuery("Dep *"); +#ifdef SWIGTCL + ecode = SWIG_AsVal_int SWIG_TCL_CALL_ARGS_2(obj, val); +#else ecode = SWIG_AsVal_int(obj, val); +#endif if (SWIG_IsOK(ecode)) return ecode; if ((SWIG_ConvertPtr(obj, &vptr, desc, 0)) == SWIG_OK) { @@ -419,6 +511,9 @@ SWIG_AsValDepId(void *obj, int *val) { return SWIG_TypeError; } +#ifdef SWIGTCL +#define SWIG_AsValDepId(x, y) SWIG_AsValDepId SWIG_TCL_CALL_ARGS_2(x, y) +#endif } %typemap(out) disown_helper { @@ -431,7 +526,15 @@ SWIG_AsValDepId(void *obj, int *val) { #ifdef SWIGPERL SWIG_ConvertPtr(ST(0), &argp1,SWIGTYPE_p_Pool, SWIG_POINTER_DISOWN | 0 ); #endif +#ifdef SWIGTCL + SWIG_ConvertPtr(objv[1], &argp1, SWIGTYPE_p_Pool, SWIG_POINTER_DISOWN | 0); +#endif + +#ifdef SWIGTCL + Tcl_SetObjResult(interp, SWIG_From_int((int)(0))); +#else $result = SWIG_From_int((int)(0)); +#endif } %include "typemaps.i" @@ -1238,8 +1341,59 @@ typedef struct { void set_loadcallback(VALUE callable) { pool_setloadcallback($self, callable ? loadcallback : 0, (void *)callable); } +#elif defined(SWIGTCL) + %{ + typedef struct { + Tcl_Interp *interp; + Tcl_Obj *obj; + } tcl_callback_t; + SWIGINTERN int loadcallback(Pool *pool, Repodata *data, void *d) { + tcl_callback_t *callback_var = (tcl_callback_t *)d; + XRepodata *xd = new_XRepodata(data->repo, data->repodataid); + Tcl_Obj *objvx[2]; + objvx[0] = callback_var->obj; + objvx[1] = SWIG_NewPointerObj(SWIG_as_voidptr(xd), SWIGTYPE_p_XRepodata, SWIG_POINTER_OWN | 0); + int result = Tcl_EvalObjv(callback_var->interp, sizeof(objvx), objvx, TCL_EVAL_GLOBAL); + int ecode = 0; + int vresult = 0; + Tcl_DecrRefCount(objvx[1]); + if (result != TCL_OK) + return 0; /* exception */ + ecode = SWIG_AsVal_int(callback_var->interp, Tcl_GetObjResult(callback_var->interp), &vresult); + return SWIG_IsOK(ecode) ? vresult : 0; + } + %} + void set_loadcallback(Tcl_Obj *callable, Tcl_Interp *interp) { + tcl_callback_t *callable_temp; + if ($self->loadcallback == loadcallback) { + tcl_callback_t *obj = $self->loadcallbackdata; + Tcl_DecrRefCount(obj->obj); + free(obj); + } + if (callable) { + Tcl_IncrRefCount(callable); + callable_temp = malloc(sizeof(tcl_callback_t)); + callable_temp->interp = interp; + callable_temp->obj = callable; + } + else { + callable_temp = NULL; + } + pool_setloadcallback($self, callable ? loadcallback : 0, callable_temp); + } #endif +#if defined(SWIGTCL) + ~Pool() { + Pool_set_loadcallback($self, 0, 0); + pool_free($self); + } + disown_helper free() { + Pool_set_loadcallback($self, 0, 0); + pool_free($self); + return 0; + } +#else ~Pool() { Pool_set_loadcallback($self, 0); pool_free($self); @@ -1249,6 +1403,7 @@ typedef struct { pool_free($self); return 0; } +#endif disown_helper disown() { return 0; } diff --git a/bindings/tcl/CMakeLists.txt b/bindings/tcl/CMakeLists.txt new file mode 100644 index 00000000..f78de9f9 --- /dev/null +++ b/bindings/tcl/CMakeLists.txt @@ -0,0 +1,38 @@ +FIND_PACKAGE (TCL) + +SET (SWIG_TCL_FLAGS -namespace -pkgversion ${VERSION}) + +EXECUTE_PROCESS ( + COMMAND echo "puts -nonewline [lindex [::tcl::tm::list] end]" + COMMAND ${TCL_TCLSH} + OUTPUT_VARIABLE TCL_INSTALL_DIR +) + +MESSAGE (STATUS "Tclsh executable: ${TCL_TCLSH}") +MESSAGE (STATUS "Tcl installation dir: ${TCL_INSTALL_DIR}") + +ADD_CUSTOM_COMMAND ( + OUTPUT solv_tcl.c + COMMAND ${SWIG_EXECUTABLE} ${SWIG_FLAGS} -tcl ${SWIG_TCL_FLAGS} -I${CMAKE_SOURCE_DIR}/src -o solv_tcl.c ${CMAKE_SOURCE_DIR}/bindings/solv.i + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + DEPENDS ${CMAKE_SOURCE_DIR}/bindings/solv.i +) + +ADD_DEFINITIONS(-Wno-unused) +INCLUDE_DIRECTORIES (${TCL_INCLUDE_PATH}) + +ADD_LIBRARY (bindings_tcl SHARED solv_tcl.c) +SET_TARGET_PROPERTIES (bindings_tcl PROPERTIES PREFIX "" OUTPUT_NAME "solv-${VERSION}" INSTALL_NAME_DIR "${TCL_INSTALL_DIR}") +TARGET_LINK_LIBRARIES (bindings_tcl libsolvext libsolv ${TCL_LIBRARY} ${SYSTEM_LIBRARIES}) +INSTALL (TARGETS bindings_tcl LIBRARY DESTINATION ${TCL_INSTALL_DIR}) + +ADD_CUSTOM_COMMAND ( + OUTPUT solv.tm + COMMAND sed -e "s/__VERSION__/${VERSION}/" ${CMAKE_SOURCE_DIR}/bindings/tcl/solv.tm.in >${CMAKE_CURRENT_BINARY_DIR}/solv.tm + DEPENDS ${CMAKE_SOURCE_DIR}/bindings/tcl/solv.tm.in + COMMENT "Creating Tcl module to load libsolv" +) +ADD_CUSTOM_TARGET (solv_tm ALL DEPENDS solv.tm) +SET_SOURCE_FILES_PROPERTIES (solv.tm PROPERTIES GENERATED TRUE) + +INSTALL (FILES ${CMAKE_CURRENT_BINARY_DIR}/solv.tm DESTINATION ${TCL_INSTALL_DIR} RENAME solv-${VERSION}.tm) diff --git a/bindings/tcl/solv.tm.in b/bindings/tcl/solv.tm.in new file mode 100644 index 00000000..3b94771c --- /dev/null +++ b/bindings/tcl/solv.tm.in @@ -0,0 +1,4 @@ +package require Tcl + +#package provide solv __VERSION__ +load [::file join [::file dirname [::info script]] "solv-__VERSION__[::info sharedlibextension]"]