IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Add support for guile 2.2

Browse Source
This commit is contained in:
Geert Janssens 2017-12-19 16:53:40 +01:00
parent 76921b5e28
commit a784dd5784
21 changed files with 175 additions and 264 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
CMakeLists.txt
View File

@ -269,37 +269,54 @@ IF(BUILDING_FROM_VCS)
ENDIF()
# Find Guile and determine which version we are using.
# First look for guile-2.0. If not found, try to locate guile-1.8
# Look for guile versions in this order: 2.2 > 2.0 > 1.8
# guile library and include dir
GNC_PKG_CHECK_MODULES (GUILE2 guile-2.0>=2.0.9 QUIET)
IF (GUILE2_FOUND) # found guile-2.0
ADD_DEFINITIONS (-DHAVE_GUILE20)
GNC_PKG_CHECK_MODULES (GUILE22 guile-2.2 QUIET)
IF (GUILE22_FOUND) # found guile-2.2
ADD_DEFINITIONS (-DHAVE_GUILE22)
SET(HAVE_GUILE2 TRUE)
SET(GUILE_EFFECTIVE_VERSION 2.0)
SET(GUILE_INCLUDE_DIRS ${GUILE2_INCLUDE_DIRS})
SET(GUILE_LDFLAGS ${GUILE2_LDFLAGS})
SET(GUILE_EFFECTIVE_VERSION 2.2)
SET(GUILE_INCLUDE_DIRS ${GUILE22_INCLUDE_DIRS})
SET(GUILE_LDFLAGS ${GUILE22_LDFLAGS})
FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.0 guild)
FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.2 guild)
IF (NOT GUILD_EXECUTABLE)
MESSAGE (SEND_ERROR "The guild executable was not found, but is required. Please set GUILD_EXECUTABLE.")
ENDIF (NOT GUILD_EXECUTABLE)
MESSAGE(STATUS "Using guile-2.0.x")
FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.0 guile)
ELSE()
# look for guile 1.8
GNC_PKG_CHECK_MODULES (GUILE1 guile-1.8>=1.8.8 QUIET)
IF (NOT GUILE1_FOUND)
MESSAGE (FATAL_ERROR "Neither guile 1.8 nor guile 2.0 were found GnuCash can't run without one of them. Ensure that one is installed and can be found with pgk-config.")
ENDIF(NOT GUILE1_FOUND)
MESSAGE(STATUS "Using guile-2.2.x")
FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.2 guile)
ELSE(GUILE22_FOUND)
GNC_PKG_CHECK_MODULES (GUILE2 guile-2.0>=2.0.9 QUIET)
IF (GUILE2_FOUND) # found guile-2.0
ADD_DEFINITIONS (-DHAVE_GUILE20)
SET(HAVE_GUILE2 TRUE)
SET(GUILE_EFFECTIVE_VERSION 2.0)
SET(GUILE_INCLUDE_DIRS ${GUILE2_INCLUDE_DIRS})
SET(GUILE_LDFLAGS ${GUILE2_LDFLAGS})
SET(HAVE_GUILE1 TRUE)
SET(GUILE_EFFECTIVE_VERSION 1.8)
SET(GUILE_INCLUDE_DIRS ${GUILE1_INCLUDE_DIRS})
SET(GUILE_LDFLAGS ${GUILE1_LDFLAGS})
MESSAGE(STATUS "Using guile-1.8.x")
FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile1.8 guile)
ENDIF()
FIND_PROGRAM (GUILD_EXECUTABLE NAMES guild2.0 guild)
IF (NOT GUILD_EXECUTABLE)
MESSAGE (SEND_ERROR "The guild executable was not found, but is required. Please set GUILD_EXECUTABLE.")
ENDIF (NOT GUILD_EXECUTABLE)
MESSAGE(STATUS "Using guile-2.0.x")
FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile2.0 guile)
ELSE(GUILE2_FOUND)
# look for guile 1.8
GNC_PKG_CHECK_MODULES (GUILE1 guile-1.8>=1.8.8 QUIET)
IF (NOT GUILE1_FOUND)
MESSAGE (FATAL_ERROR "Neither guile 1.8 nor guile 2.0 were found GnuCash can't run without one of them. Ensure that one is installed and can be found with pgk-config.")
ENDIF(NOT GUILE1_FOUND)
SET(HAVE_GUILE1 TRUE)
SET(GUILE_EFFECTIVE_VERSION 1.8)
SET(GUILE_INCLUDE_DIRS ${GUILE1_INCLUDE_DIRS})
SET(GUILE_LDFLAGS ${GUILE1_LDFLAGS})
MESSAGE(STATUS "Using guile-1.8.x")
FIND_PROGRAM (GUILE_EXECUTABLE NAMES guile1.8 guile)
ENDIF(GUILE2_FOUND)
ENDIF(GUILE22_FOUND)
IF (NOT GUILE_EXECUTABLE)
MESSAGE (SEND_ERROR "The guile executable was not found, but is required. Please set GUILE_EXECUTABLE.")

4
common/cmake_modules/GncAddSchemeTargets.cmake
View File

@ -88,12 +88,12 @@ FUNCTION(GNC_ADD_SCHEME_TARGETS _TARGET _SOURCE_FILES _OUTPUT_DIR _GUILE_DEPENDS
"${current_bindir}" "${CMAKE_BINARY_DIR}/libgnucash/scm") # to pick up generated build-config.scm
SET(_GUILE_LOAD_COMPILED_PATH "${current_bindir}")
SET(_GUILE_CACHE_DIR ${LIBDIR_BUILD}/gnucash/scm/ccache/2.0)
SET(_GUILE_CACHE_DIR ${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION})
SET(_GUILE_LOAD_PATH "${current_srcdir}")
IF (MAKE_LINKS)
LIST(APPEND _GUILE_LOAD_PATH "${build_datadir}/gnucash/scm")
ENDIF()
SET(_GUILE_LOAD_COMPILED_PATH ${build_libdir}/gnucash/scm/ccache/2.0)
SET(_GUILE_LOAD_COMPILED_PATH ${build_libdir}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION})
SET(_TARGET_FILES "")

4
common/cmake_modules/GncAddTest.cmake
View File

@ -25,7 +25,7 @@ FUNCTION(GET_GUILE_ENV)
set(fpath "${fpath}${dir}:")
endforeach(dir)
LIST(APPEND env "PATH=${fpath}")
set(compiled_path "${LIBDIR_BUILD}/gnucash/scm/ccache/2.0")
set(compiled_path "${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION}")
string(REGEX REPLACE "^([A-Za-z]):" "/\\1" compiled_path ${compiled_path})
LIST(APPEND env GUILE_LOAD_COMPILED_PATH=${compiled_path})
ENDIF(MINGW64)
@ -33,7 +33,7 @@ FUNCTION(GET_GUILE_ENV)
LIST(APPEND env "GUILE=${GUILE_EXECUTABLE}")
IF (NOT WIN32)
LIST(APPEND env "GUILE_LOAD_COMPILED_PATH=${LIBDIR_BUILD}/gnucash/scm/ccache/2.0")
LIST(APPEND env "GUILE_LOAD_COMPILED_PATH=${LIBDIR_BUILD}/gnucash/scm/ccache/${GUILE_EFFECTIVE_VERSION}")
ENDIF()
SET(guile_load_paths "")
LIST(APPEND guile_load_paths ${CMAKE_CURRENT_SOURCE_DIR}/mod-foo)

6
gnucash/environment.in
View File

@ -1,7 +1,5 @@
@-NOTE If you make any changes here, you should probably -@
@-NOTE also change the equivalent sections in: -@
@-NOTE - src/bin/overrides/gnucash-env.in -@
@-NOTE Check as well that modifications performed in -@
@-NOTE also verify that modifications performed in -@
@-NOTE - gnucash-on-windows.git:gnucash.iss don't conflict. -@
# environment
#
@ -66,7 +64,7 @@ GUILE_LOAD_PATH={GNC_DATA}/scm;{GUILE_LIBS};{GUILE_LOAD_PATH}
# On Windows {GNC_LIB} points to {GNC_HOME}/bin because that's where the DLLs
# are. It's not where the compiled scheme files are so we use {SYS_LIB} here.
GUILE_LOAD_COMPILED_PATH={SYS_LIB}/guile/2.0/ccache;{SYS_LIB}/gnucash/scm/ccache/@-GUILE_EFFECTIVE_VERSION-@;{GUILE_COMPILED_LIBS};{GUILE_LOAD_COMPILED_PATH}
GUILE_LOAD_COMPILED_PATH={SYS_LIB}/guile/@-GUILE_EFFECTIVE_VERSION-@/ccache;{SYS_LIB}/gnucash/scm/ccache/@-GUILE_EFFECTIVE_VERSION-@;{GUILE_COMPILED_LIBS};{GUILE_LOAD_COMPILED_PATH}
# Tell Guile where to find GnuCash specific shared libraries
GNC_LIBRARY_PATH={SYS_LIB};{GNC_LIB}

3
gnucash/import-export/qif-imp/Makefile.am
View File

@ -100,7 +100,10 @@ endif
if GNC_HAVE_GUILE_2
GUILE_COMPILE_ENV = \
--gnc-module-dir ${top_builddir}/libgnucash/engine \
--guile-load-dir ${top_builddir}/libgnucash/app-utils \
--guile-load-dir ${top_builddir}/libgnucash/core-utils \
--guile-load-dir ${top_builddir}/libgnucash/engine \
--guile-load-dir ${top_builddir}/libgnucash/gnc-module \
--guile-load-dir ${top_builddir}/libgnucash/scm \
--library-dir ${top_builddir}/libgnucash/engine \

2
gnucash/import-export/qif-imp/qif-import.scm
View File

@ -26,6 +26,7 @@
(define-module (gnucash import-export qif-import))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash app-utils))
;; We do this initialization here because src/gnome isn't a real module.
;; Note: Guile 2 needs to find the symbols from the extension at compile time already
@ -43,7 +44,6 @@
(use-modules (ice-9 regex))
(use-modules (srfi srfi-1))
(debug-enable 'debug)
(debug-enable 'backtrace)
(gnc:module-load "gnucash/engine" 0)

10
gnucash/report/report-gnome/dialog-report-column-view.c
View File

@ -432,7 +432,7 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
oldlist = SCM_CDR(oldlist);
}
newlist = scm_append
(scm_listify(scm_reverse(scm_cons(SCM_LIST4(new_report,
(scm_list_n (scm_reverse(scm_cons(SCM_LIST4(new_report,
scm_from_int (1),
scm_from_int (1),
SCM_BOOL_F),
@ -443,7 +443,7 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
else
{
newlist = scm_append
(scm_listify(oldlist,
(scm_list_n (oldlist,
SCM_LIST1(SCM_LIST4(new_report,
scm_from_int (1),
scm_from_int (1),
@ -485,7 +485,7 @@ gnc_column_view_edit_remove_cb(GtkButton * button, gpointer user_data)
}
if (count <= oldlength)
{
newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
}
}
@ -528,7 +528,7 @@ gnc_edit_column_view_move_up_cb(GtkButton * button, gpointer user_data)
temp = SCM_CAR(oldlist);
oldlist = SCM_CDR(oldlist);
newlist = scm_cons(temp, scm_cons(SCM_CAR(oldlist), newlist));
newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
scm_gc_unprotect_object(r->contents_list);
r->contents_list = newlist;
@ -566,7 +566,7 @@ gnc_edit_column_view_move_down_cb(GtkButton * button, gpointer user_data)
temp = SCM_CAR(oldlist);
oldlist = SCM_CDR(oldlist);
newlist = scm_cons(temp, scm_cons(SCM_CAR(oldlist), newlist));
newlist = scm_append(scm_listify(scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
newlist = scm_append(scm_list_n (scm_reverse(newlist), SCM_CDR(oldlist), SCM_UNDEFINED));
scm_gc_unprotect_object(r->contents_list);
r->contents_list = newlist;

7
gnucash/report/report-gnome/test/test-load-report-gnome-module.scm
View File

@ -2,7 +2,6 @@
exec ${GUILE} -s "$0"
!#
(debug-enable 'debug)
(debug-enable 'backtrace)
(debug-set! stack 500000)
@ -10,7 +9,11 @@ exec ${GUILE} -s "$0"
(debug-set! maxdepth 100000))
(display " testing report module load ... ")
(use-modules (ice-9 syncase))
(cond-expand
(guile-2 )
(else
;; Syncase is deprecated and redundant in guile 2
(use-modules (ice-9 syncase))))
(use-modules (gnucash gnc-module))
(gnc:module-system-init)

1
gnucash/report/report-system/report.scm
View File

@ -21,6 +21,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash main))
(use-modules (gnucash app-utils))
(use-modules (gnucash printf))
(use-modules (gnucash gettext))
(cond-expand

7
gnucash/report/report-system/test/test-load-report-system-module.scm
View File

@ -1,4 +1,3 @@
(debug-enable 'debug)
(debug-enable 'backtrace)
(debug-set! stack 500000)
@ -7,7 +6,11 @@
(display " testing report module load ... ")
(setenv "GNC_UNINSTALLED" "1")
(use-modules (ice-9 syncase))
(cond-expand
(guile-2 )
(else
;; Syncase is deprecated and redundant in guile 2
(use-modules (ice-9 syncase))))
(use-modules (gnucash gnc-module))
(gnc:module-system-init)

5
gnucash/report/utility-reports/hello-world.scm
View File

@ -28,11 +28,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
;; 'debug is deprecated and unused since guile 2
(cond-expand
(guile-2 )
(else
(debug-enable 'debug)))
(debug-enable 'backtrace)
(gnc:module-load "gnucash/report/report-system" 0)

1
gnucash/report/utility-reports/test-graphing.scm
View File

@ -27,7 +27,6 @@
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash gnc-module))
(debug-enable 'debug)
(debug-enable 'backtrace)
(gnc:module-load "gnucash/report/report-system" 0)

1
gnucash/report/utility-reports/view-column.scm
View File

@ -28,6 +28,7 @@
(define-module (gnucash report view-column))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (gnucash app-utils))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(cond-expand

4
libgnucash/app-utils/app-utils.scm
View File

@ -43,7 +43,9 @@
(re-export N_)
;; c-interface.scm
(export gnc:error->string)
(export gnc:apply-with-error-handling)
(export gnc:eval-string-with-error-handling)
(export gnc:backtrace-if-exception)
(export gnc:make-string-database)
;; options.scm

80
libgnucash/app-utils/c-interface.scm
View File

@ -15,25 +15,67 @@
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
(define (gnc:error->string tag args)
(define (write-error port)
(if (and (list? args) (not (null? args)))
(let ((func (car args)))
(if func
(begin
(display "Function: " port)
(display func port)
(display ", " port)
(display tag port)
(display "\n\n" port)))))
(false-if-exception
(apply display-error (fluid-ref the-last-stack) port args))
(display-backtrace (fluid-ref the-last-stack) port)
(force-output port))
(false-if-exception
(call-with-output-string write-error)))
(define (gnc:call-with-error-handling cmd args)
(let ((captured-stack #f)
(captured-error #f)
(result #f))
(catch #t
(lambda ()
;; Execute the code in which
;; you want to catch errors here.
(if (procedure? cmd)
(set! result (apply cmd args)))
(if (string? cmd)
(set! result (eval-string cmd)))
)
(lambda (key . parameters)
;; Put the code which you want
;; to handle an error after the
;; stack has been unwound here.
(let* ((str-port (open-output-string)))
(display-backtrace captured-stack str-port)
(display "\n" str-port)
(print-exception str-port #f key parameters)
(set! captured-error (get-output-string str-port))))
(lambda (key . parameters)
;; Capture the stack here, cut the last 3 frames which are
;; make-stack, this one, and the throw handler.
(set! captured-stack (make-stack #t 3))))
(list result captured-error)
))
;; gnc:eval-string-with-error-handling will evaluate the input string (cmd)
;; an captures any exception that would be generated. It returns
;; a list with 2 elements: the output of the evaluation and a backtrace.
;; The first may be set if string evaluation did generate
;; output, the latter is set when an exception was caught.
;; We'll use this to wrap guile calls in C(++), allowing
;; the C(++) code to decide how to handle the errors.
(define (gnc:eval-string-with-error-handling cmd)
(gnc:call-with-error-handling cmd '()))
;; gnc:apply-with-error-handling will call guile's apply to run func with args
;; an captures any exception that would be generated. It returns
;; a list with 2 elements: the output of the evaluation and a backtrace.
;; The first may be set if the result of the apply did generate
;; output, the latter is set when an exception was caught.
;; We'll use this to wrap guile calls in C(++), allowing
;; the C(++) code to decide how to handle the errors.
(define (gnc:apply-with-error-handling func args)
(gnc:call-with-error-handling func args))
(define (gnc:backtrace-if-exception proc . args)
(let* ((apply-result (gnc:apply-with-error-handling proc args))
(result (car apply-result))
(error (cadr apply-result)))
(if error
(begin
(display error (current-error-port))
(if (defined? 'gnc:warn)
(gnc:warn error)))
result)))
;; This database can be used to store and retrieve translatable
;; strings. Strings that are returned by the lookup function are
@ -56,5 +98,5 @@
(if func
(apply func args)
(gnc:warn "string-database: bad message" message "\n"))))
dispatch)

189
libgnucash/app-utils/gfec.c
View File

@ -18,134 +18,31 @@
# define strdup _strdup
#endif
typedef struct {
char **msg;
SCM *scm_string;
} helper_data_t;
static SCM helper_scm_to_string(void *ptr_void)
{
helper_data_t* ptr = ptr_void;
g_assert(ptr);
*(ptr->msg) = gnc_scm_to_utf8_string(*ptr->scm_string);
return SCM_UNDEFINED;
}
static int gfec_catcher_recursion_level = 0;
/* We assume that data is actually a char**. The way we return results
* from this function is to malloc a fresh string, and store it in
* this pointer. It is the caller's responsibility to do something
* smart with this freshly allocated storage. the caller can determine
* whether there was an error by initializing the char* passed in to
* NULL. If there is an error, the char string will not be NULL on
* return.
*
* This function might call itself recursively: The conversion of the error
* object to a string might itself throw an exception, hence the scm_to_string
* function must be wrapped into a stack_catch block as well. To avoid infinite
* recursion, we check the recursion level by gfec_catcher_recursion_level.
*/
static SCM
gfec_catcher(void *data, SCM tag, SCM throw_args)
{
SCM func;
SCM result;
char *msg = NULL;
// To much recursion? Better jump out of here quickly.
if (gfec_catcher_recursion_level > 2)
{
*(char**)data = strdup("Guile error: Too many recursions in error catch handler.");
return SCM_UNDEFINED;
}
gfec_catcher_recursion_level++;
func = scm_c_eval_string("gnc:error->string");
if (scm_is_procedure(func))
{
result = scm_call_2(func, tag, throw_args);
if (scm_is_string(result))
{
char *internal_err_msg = NULL;
helper_data_t helper_data;
helper_data.msg = &msg;
helper_data.scm_string = &result;
// The conversion to string can itself throw as well
scm_internal_stack_catch(SCM_BOOL_T,
helper_scm_to_string,
(void *) &helper_data,
gfec_catcher,
&internal_err_msg);
// Previously: msg = gnc_scm_to_utf8_string (result);
// Did we run into an exception? Then the output argument msg is
// not set (due to the exception), but err_msg is set and contains
// that error message. We thus pass the err_msg instead of msg to
// our caller.
if (internal_err_msg)
{
msg = internal_err_msg;
}
}
}
if (msg == NULL)
{
*(char**)data = strdup("Error running guile function.");
}
else
{
*(char**)data = strdup(msg);
g_free(msg);
}
--gfec_catcher_recursion_level;
return SCM_UNDEFINED;
}
/* The arguments to scm_internal_stack_catch:
------------------------------------------
SCM tag : this should be SCM_BOOL_T to catch all errors.
scm_catch_body_t body : the function to run.
void *body_data : a pointer to pass to body
scm_catch_handler_t handler : the hander function
void *handler_data : a pointer to pass to the handler
*/
static SCM
gfec_string_helper(void *data)
{
char *string = data;
return scm_c_eval_string(string);
}
SCM
gfec_eval_string(const char *str, gfec_error_handler error_handler)
{
char *err_msg = NULL;
SCM result;
result = scm_internal_stack_catch(SCM_BOOL_T,
gfec_string_helper,
(void *) str,
gfec_catcher,
&err_msg);
if (err_msg != NULL)
SCM result = SCM_UNDEFINED;
SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
if (scm_is_procedure(func))
{
if (error_handler)
error_handler(err_msg);
char *err_msg = NULL;
SCM call_result, error = SCM_UNDEFINED;
call_result = scm_call_1 (func, scm_from_utf8_string (str));
free(err_msg);
error = scm_list_ref (call_result, scm_from_uint (1));
if (scm_is_true (error))
err_msg = gnc_scm_to_utf8_string (error);
else
result = scm_list_ref (call_result, scm_from_uint (0));
return SCM_UNDEFINED;
if (err_msg != NULL)
{
if (error_handler)
error_handler (err_msg);
free(err_msg);
}
}
return result;
@ -175,44 +72,30 @@ gfec_eval_file(const char *file, gfec_error_handler error_handler)
return result;
}
struct gfec_apply_rec
{
SCM proc;
SCM arglist;
};
static SCM
gfec_apply_helper(void *data)
{
struct gfec_apply_rec *apply_rec = (struct gfec_apply_rec *)data;
return scm_apply(apply_rec->proc, apply_rec->arglist, SCM_EOL);
}
SCM
gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler)
{
char *err_msg = NULL;
struct gfec_apply_rec apply_rec;
SCM result;
apply_rec.proc = proc;
apply_rec.arglist = arglist;
result = scm_internal_stack_catch(SCM_BOOL_T,
gfec_apply_helper,
&apply_rec,
gfec_catcher,
&err_msg);
if (err_msg != NULL)
SCM result = SCM_UNDEFINED;
SCM func = scm_c_eval_string("gnc:apply-with-error-handling");
if (scm_is_procedure(func))
{
if (error_handler)
error_handler(err_msg);
char *err_msg = NULL;
SCM call_result, error;
call_result = scm_call_2 (func, proc, arglist);
free(err_msg);
error = scm_list_ref (call_result, scm_from_uint (1));
if (scm_is_true (error))
err_msg = gnc_scm_to_utf8_string (error);
else
result = scm_list_ref (call_result, scm_from_uint (0));
return SCM_UNDEFINED;
if (err_msg != NULL)
{
if (error_handler)
error_handler (err_msg);
free(err_msg);
}
}
return result;

2
libgnucash/app-utils/gnc-exp-parser.c
View File

@ -302,7 +302,7 @@ func_op(const char *fname, int argc, void **argv)
printf( "gnc:\"%s\" is not a scm procedure\n", fname );
return NULL;
}
scmArgs = scm_listify( SCM_UNDEFINED );
scmArgs = scm_list_n (SCM_UNDEFINED);
for ( i = 0; i < argc; i++ )
{
/* cons together back-to-front. */

6
libgnucash/app-utils/test/test-exp-parser.c
View File

@ -189,9 +189,9 @@ test_parser (void)
"- 42.72 + 13.32 + 15.48 + 23.4 + 115.4",
gnc_numeric_create(35897, 100) );
/* This must be defined for the function-parsing to work. */
scm_c_eval_string("(define (gnc:error->string tag args) (define (write-error port) (if (and (list? args) (not (null? args))) (let ((func (car args))) (if func (begin (display \"Function: \" port) (display func port) (display \", \" port) (display tag port) (display \"\n\n\" port))))) (false-if-exception (apply display-error (fluid-ref the-last-stack) port args)) (display-backtrace (fluid-ref the-last-stack) port) (force-output port)) (false-if-exception (call-with-output-string write-error)))");
/* gnc:apply-with-error-handling must be defined because it's used
* indirectly through gfec_apply by the expression parser */
scm_c_eval_string("(define (gnc:apply-with-error-handling cmd args) (let ((captured-stack #f) (captured-error #f) (result #f)) (catch #t (lambda () (if (procedure? cmd) (set! result (apply cmd args))) (if (string? cmd) (set! result (eval-string cmd)))) (lambda (key . parameters) (let* ((str-port (open-output-string))) (display-backtrace captured-stack str-port) (display \"\n\" str-port) (print-exception str-port #f key parameters) (set! captured-error (get-output-string str-port)))) (lambda (key . parameters) (set! captured-stack (make-stack #t 3)))) (list result captured-error)))");
scm_c_eval_string( "(define (gnc:plus a b) (+ a b))" );
add_pass_test("plus(2 : 1)", NULL, gnc_numeric_create(3, 1));
add_fail_test("plus(1:2) plus(3:4)", NULL, 15);

6
libgnucash/app-utils/test/test-load-app-utils-module.scm
View File

@ -21,10 +21,10 @@
(display "Failed - module gnucash/app-utils not loaded successfully\n")
(set! exit-code -1)))
(if (procedure? gnc:error->string)
(display "Procedure gnc:error->string found\n")
(if (procedure? gnc:apply-with-error-handling)
(display "Procedure gnc:apply-with-error-handling found\n")
(begin
(display "Failed - procedure gnc:error->string not found\n")
(display "Failed - procedure gnc:apply-with-error-handling not found\n")
(set! exit-code -1)))
(if (procedure? gnc-default-currency)

2
libgnucash/app-utils/test/test-scm-query-string.cpp
View File

@ -135,7 +135,7 @@ main (int argc, char **argv)
/* When built with clang, guile-1.8.8's scm_c_eval_string truncates all
* integer values to int32, which causes this test to fail.
*/
#if !(defined(__clang__)) || defined(HAVE_GUILE20)
#if !(defined(__clang__)) || defined(HAVE_GUILE20) || defined(HAVE_GUILE22)
scm_boot_guile (argc, argv, main_helper, NULL);
#endif
return 0;

36
libgnucash/scm/main.scm
View File

@ -53,7 +53,6 @@
(export gnc:error)
(export gnc:msg)
(export gnc:debug)
(export gnc:backtrace-if-exception)
(export gnc:safe-strcmp) ;; only used by aging.scm atm...
;; Get the Makefile.am/configure.in generated variables.
@ -64,15 +63,6 @@
;; These are needed for a guile 1.3.4 bug
(debug-enable 'backtrace)
(read-enable 'positions)
;; These options should only be set for guile < 2.0
;; 'debug (deprecated and unused since guile 2)
;; maxdepth (removed since guile 2)
(cond-expand
(guile-2 )
(else
(debug-enable 'debug)
(debug-set! maxdepth 100000)))
(debug-set! stack 200000)
;; Initalialize localization, otherwise reports may output
@ -94,32 +84,6 @@
(b -1)
(else 0))))
(define (gnc:backtrace-if-exception proc . args)
(define (dumper key . args)
(let ((stack (make-stack #t dumper)))
;; Send debugging output to the console.
(display-backtrace stack (current-error-port))
(apply display-error stack (current-error-port) args)
;; Send debugging output to the log.
(if (defined? 'gnc:warn)
(let ((string-port (open-output-string)))
(display-backtrace stack string-port)
(apply display-error stack string-port args)
(gnc:warn (get-output-string string-port))
(close-output-port string-port)))
(throw 'ignore)))
(catch
'ignore
(lambda ()
(lazy-catch #t
(lambda () (apply proc args))
dumper))
(lambda (key . args)
#f)))
;;;; Status output functions.
(define (strify items)