diff --git a/CHANGELOG b/CHANGELOG index fd31e13e3..d707549e0 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -78,6 +78,9 @@ handler so the thread wakeup wasn't working because the handler is not more vali - import thread wasn't set upping a proper environment: on some case the thread was mistakenly thinking that the thread was already registered. +- ECL_HANDLER_CASE and ECL_RESTART_CASE didn't work as expected +Bug identified and fixed by Vadim Penzin. + * 16.1.2 changes since 16.0.0 ** API changes diff --git a/doc/ref_c_conditions.xml b/doc/ref_c_conditions.xml index 7766b9d85..e079301c0 100644 --- a/doc/ref_c_conditions.xml +++ b/doc/ref_c_conditions.xml @@ -30,14 +30,14 @@ The following example shows how to establish a handler for ERROR conditions. Note how the first value to ECL_HANDLER_CASE matches the position of the restart name in the list: cl_object error = ecl_make_symbol("ERROR","CL"); -ECL_RESTART_BEGIN(the_env, ecl_list1(error)) { +ECL_HANDLER_CASE_BEGIN(the_env, ecl_list1(error)) { /* This form is evaluated with bound handlers */ output = cl_eval(1, form); } ECL_HANDLER_CASE(1, condition) { /* This code is executed when an error happens */ /* We just return the error that took place */ output = condition; -} ECL_RESTART_END; +} ECL_HANDLER_CASE_END; @@ -65,7 +65,7 @@ ECL_RESTART_BEGIN(the_env, ecl_list1(error)) { cl_object abort = ecl_make_symbol("ABORT","CL"); cl_object use_value = ecl_make_symbol("USE-VALUE","CL"); -ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) { +ECL_RESTART_CASE_BEGIN(the_env, cl_list(2, abort, use_value)) { /* This form is evaluated with bound restarts */ output = cl_eval(1, form); } ECL_RESTART_CASE(1, args) { @@ -74,7 +74,7 @@ ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) { } ECL_RESTART_CASE(2, args) { /* This code is executed when the 2nd restart (ABORT) is invoked */ output = ECL_CAR(args); -} ECL_RESTART_END; +} ECL_RESTART_CASE_END; @@ -171,4 +171,4 @@ ECL_RESTART_BEGIN(the_env, cl_list(2, abort, use_value)) { - \ No newline at end of file + diff --git a/src/Makefile.in b/src/Makefile.in index 69e8008e1..6e60a5869 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -6,6 +6,7 @@ # top_srcdir= @top_srcdir@ srcdir = @srcdir@ +datarootdir = @datarootdir@ mandir=@mandir@ manext=1 @@ -269,7 +270,7 @@ selfbuild: # like "@si::foo" and "@(defun si::foo". # This rule is allowed to fail when etags does not exist. .git/tags: - cd $(srcdir)/../.git && ctags -o tags -R --langmap=c:+.d ../src || true + ( cd $(srcdir)/../.git && ctags -o tags -R --langmap=c:+.d ../src ) || true TAGS: -if test "x$(ETAGS)" != "x"; then \ srcfiles=`find $(srcdir)/c $(srcdir)/h -name '*.[chd]'` && \ diff --git a/src/aclocal.m4 b/src/aclocal.m4 index 3e93a53d3..2b88971bb 100644 --- a/src/aclocal.m4 +++ b/src/aclocal.m4 @@ -6,7 +6,7 @@ AC_DEFUN([ECL_LONG_DOUBLE],[ if test "$enable_longdouble" != "no" ; then AC_CHECK_TYPES([long double],[enable_longdouble=yes],[enable_longdouble=no]) if test "$enable_longdouble" != "no" ; then -AC_CHECK_FUNCS([sinl cosl tanl logl expl],[],[enable_longdouble=no; break]) +AC_CHECK_FUNCS([sinl cosl tanl logl expl ldexpl frexpl],[],[enable_longdouble=no; break]) if test "$enable_longdouble" != "no" ; then AC_DEFINE([ECL_LONG_FLOAT], [], [ECL_LONG_FLOAT]) fi @@ -443,9 +443,14 @@ case "${host_os}" in clibs="-Wld=-lrld" ;; aix*) - PICFLAG='' + PICFLAG='-DPIC' thehost="aix" - shared="no" + THREAD_LIBS='-lpthread' + SHARED_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}" + BUNDLE_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}" + ECL_LDRPATH="-Wl,-R~A" + SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION" + SONAME_LDFLAGS="-bsvr4 -brtl" ;; *) thehost="$host_os" diff --git a/src/c/ecl_features.h b/src/c/ecl_features.h index 3d9b1d1de..8442a0565 100644 --- a/src/c/ecl_features.h +++ b/src/c/ecl_features.h @@ -35,7 +35,7 @@ ecl_def_string_array(feature_names,static,const) = { #endif ecl_def_string_array_elt("ECL-PDE"), #if defined(unix) || defined(netbsd) || defined(openbsd) || defined(linux) || defined(darwin) || \ - defined(freebsd) || defined(dragonfly) || defined(kfreebsd) || defined(gnu) || defined(nsk) + defined(freebsd) || defined(dragonfly) || defined(kfreebsd) || defined(gnu) || defined(nsk) || defined(aix) ecl_def_string_array_elt("UNIX"), #endif #ifdef BSD diff --git a/src/c/stacks.d b/src/c/stacks.d index c8f6a2c13..2fc5c570a 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -28,16 +28,16 @@ cs_set_size(cl_env_ptr env, cl_index new_size) { volatile char foo = 0; cl_index margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA]; - env->cs_limit_size = new_size - 2*margin; + env->cs_limit_size = new_size - (2*margin); #ifdef ECL_DOWN_STACK - if (&foo > env->cs_org - new_size + 16) { - env->cs_limit = env->cs_org - new_size + 2*margin; + if (&foo > (env->cs_org - new_size) + 16) { + env->cs_limit = (env->cs_org - new_size) + (2*margin); if (env->cs_limit < env->cs_barrier) env->cs_barrier = env->cs_limit; } #else - if (&foo < env->cs_org + new_size - 16) { - env->cs_limit = env->cs_org + new_size - 2*margin; + if (&foo < (env->cs_org + new_size) - 16) { + env->cs_limit = (env->cs_org + new_size) - (2*margin); if (env->cs_limit > env->cs_barrier) env->cs_barrier = env->cs_limit; } @@ -96,16 +96,19 @@ ecl_cs_set_org(cl_env_ptr env) { struct rlimit rl; cl_index size; - getrlimit(RLIMIT_STACK, &rl); - if (rl.rlim_cur != RLIM_INFINITY) { + + if (!getrlimit(RLIMIT_STACK, &rl) && + ( rl.rlim_cur != RLIM_INFINITY + || rl.rlim_cur !=RLIM_SAVED_MAX + || rl.rlim_cur != RLIM_SAVED_CUR) ) { env->cs_max_size = rl.rlim_cur; size = rl.rlim_cur / 2; - if (size > (cl_index)ecl_option_values[ECL_OPT_C_STACK_SIZE]) + if (size < (cl_index)ecl_option_values[ECL_OPT_C_STACK_SIZE]) ecl_set_option(ECL_OPT_C_STACK_SIZE, size); #ifdef ECL_DOWN_STACK - env->cs_barrier = env->cs_org - rl.rlim_cur - 1024; + env->cs_barrier = (env->cs_org - rl.rlim_cur) - 1024; #else - env->cs_barrier = env->cs_org + rl.rlim_cur + 1024; + env->cs_barrier = (env->cs_org + rl.rlim_cur) + 1024; #endif } } diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp index d8ccf1a66..7139cc8b2 100644 --- a/src/clos/conditions.lsp +++ b/src/clos/conditions.lsp @@ -180,7 +180,9 @@ (name (first expression2))) (case name (SIGNAL - (setq condition-form (second expression2))) + (setq condition-form `(coerce-to-condition ,(second expression2) + (list ,@ (cddr expression2)) + 'simple-condition 'signal))) (ERROR (setq condition-form `(coerce-to-condition ,(second expression2) (list ,@(cddr expression2)) diff --git a/src/configure b/src/configure index 0b7d1c72f..4a27fb370 100755 --- a/src/configure +++ b/src/configure @@ -5054,9 +5054,14 @@ LSP_FEATURES="(cons :android ${LSP_FEATURES})" clibs="-Wld=-lrld" ;; aix*) - PICFLAG='' + PICFLAG='-DPIC' thehost="aix" - shared="no" + THREAD_LIBS='-lpthread' + SHARED_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}" + BUNDLE_LDFLAGS="-G -bsvr4 -brtl ${LDFLAGS}" + ECL_LDRPATH="-Wl,-R~A" + SONAME="${SHAREDPREFIX}ecl.${SHAREDEXT}.SOVERSION" + SONAME_LDFLAGS="-bsvr4 -brtl" ;; *) thehost="$host_os" @@ -8050,7 +8055,7 @@ else fi if test "$enable_longdouble" != "no" ; then -for ac_func in sinl cosl tanl logl expl +for ac_func in sinl cosl tanl logl expl ldexpl frexpl do : as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" @@ -10267,7 +10272,7 @@ ecl config.status 16.1.2 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." diff --git a/src/configure.ac b/src/configure.ac index 137c8b74b..3cd387e09 100644 --- a/src/configure.ac +++ b/src/configure.ac @@ -428,6 +428,8 @@ if test "x${with_system_gmp}" = "xno" ; then else GMP_ABI="ABI=$ABI" fi + # Crosscompilation for Android on Darwin requires replacing 'NM=nm' + # below with 'NM=$PLATFORM_PREFIX/bin/arm-linux-androideabi-nm'. mkdir gmp dnl Notice we need -DPIC to force the assembler to generate PIC code (destdir=`${PWDCMD}`; cd gmp && CC="${CC} ${PICFLAG}" \ diff --git a/src/doc/Makefile.in b/src/doc/Makefile.in index 190b4f71f..788512e60 100644 --- a/src/doc/Makefile.in +++ b/src/doc/Makefile.in @@ -6,6 +6,7 @@ exec_prefix=@exec_prefix@ infodir = @infodir@ mandir=@mandir@ docdir=@docdir@ +datarootdir = @datarootdir@ manext=1 INFOEXT = @INFOEXT@ diff --git a/src/ecl/configpre.h b/src/ecl/configpre.h index 2cbbdc5f3..6e42e2397 100644 --- a/src/ecl/configpre.h +++ b/src/ecl/configpre.h @@ -150,6 +150,9 @@ /* Define to 1 if you have the `frexpf' function. */ #undef HAVE_FREXPF +/* Define to 1 if you have the `frexpl' function. */ +#undef HAVE_FREXPL + /* Define to 1 if you have the `fseeko' function. */ #undef HAVE_FSEEKO @@ -183,6 +186,9 @@ /* Define to 1 if you have the `ldexpf' function. */ #undef HAVE_LDEXPF +/* Define to 1 if you have the `ldexpl' function. */ +#undef HAVE_LDEXPL + /* HAVE_LIBFFI */ #undef HAVE_LIBFFI diff --git a/src/h/internal.h b/src/h/internal.h index 7f4edb0e9..53ed6b3e4 100755 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -488,7 +488,7 @@ extern cl_fixnum ecl_runtime(void); #ifdef ECL_THREADS extern void ecl_process_yield(void); extern void print_lock(char *s, cl_object lock, ...); -#define print_lock(a,b,...) ((void)0) +#define print_lock(...) ((void)0) extern void ecl_get_spinlock(cl_env_ptr env, cl_object *lock); extern void ecl_giveup_spinlock(cl_object *lock); extern cl_object ecl_wait_on(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object), cl_object o); diff --git a/src/h/stacks.h b/src/h/stacks.h index f045295b2..732110f42 100755 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -423,9 +423,8 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje if (ecl_frs_push(__the_env,__ecl_tag) == 0) { #define ECL_RESTART_CASE(code, args) \ - } else if (__the_env->values[1] == ecl_make_fixnum(code)) { \ - const cl_object args = __the_env->values[0]; - + } else if (__the_env->values[0] == ecl_make_fixnum(code)) { \ + const cl_object args = __the_env->values[1]; #define ECL_RESTART_CASE_END } \ ecl_frs_pop(__the_env); \ @@ -440,9 +439,8 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje if (ecl_frs_push(__the_env,__ecl_tag) == 0) { #define ECL_HANDLER_CASE(code, args) \ - } else if (__the_env->values[1] == ecl_make_fixnum(code)) { \ - const cl_object args = __the_env->values[0]; - + } else if (__the_env->values[0] == ecl_make_fixnum(code)) { \ + const cl_object args = __the_env->values[1]; #define ECL_HANDLER_CASE_END } \ ecl_frs_pop(__the_env); \ diff --git a/src/tests/regressions/tests/compiler.lsp b/src/tests/regressions/tests/compiler.lsp index c2650bc51..f1d9a0bee 100644 --- a/src/tests/regressions/tests/compiler.lsp +++ b/src/tests/regressions/tests/compiler.lsp @@ -1170,7 +1170,10 @@ ;;; Date 2016-04-21 +;;; Fixed: Daniel Kochmański ;;; Description +;;; typep didn't recognize * as a t abberv +;;; (deftest compiler.0051.ftype-args* (progn (declaim (ftype (function (*) (values T)) ce)) diff --git a/src/tests/regressions/tests/embedding.lsp b/src/tests/regressions/tests/embedding.lsp index 84eab7cc4..dcad21805 100644 --- a/src/tests/regressions/tests/embedding.lsp +++ b/src/tests/regressions/tests/embedding.lsp @@ -14,10 +14,10 @@ (princ c-code s)) (c::compiler-cc "tmp/aux.c" "tmp/aux.o") (c::linker-cc "tmp/aux.exe" '("tmp/aux.o")) - (case capture-output - (nil + (ecase capture-output + ((nil) (return-from test-C-program (zerop (si::system "tmp/aux.exe")))) - (STRING + ((string :string) (with-output-to-string (s) (let ((in (si::run-program "tmp/aux.exe" '() :output :stream)) line) @@ -25,7 +25,7 @@ (setf line (read-line in nil)) (unless line (return)) (write-line line s))))) - (T + ((t forms :forms) (do* ((all '()) (x t) (in (si::run-program "tmp/aux.exe" '() :output :stream))) @@ -57,6 +57,50 @@ int main (int argc, char **argv) { }") (form '(push (lambda () (print :shutdown)) si::*exit-hooks*)) (c-code (format nil skeleton (format nil "~S" form))) - (data (test-C-program (print c-code) :capture-output t))) + (data (test-C-program c-code :capture-output t))) data) (:shutdown)) + +;;; Date: 2016-05-25 (Vadim Penzin) +;;; Date: 2016-05-27 (Vadim Penzin) +;;; Description: +;;; +;;; ECL_HANDLER_CASE C macro misses condition handlers because the +;;; macro looks up handler tags in env->values[1] instead of +;;; env->values[0] and copies the condition object from +;;; env->values[0] instead of env->values[1]. +;;; +;;; Case study: http://penzin.net/ecl-handler-case.html +;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/248 +;;; Notes: +;;; +;;; ECL_RESTART_CASE is very similar, but testing would require +;;; user interaction (ie picking the restart), hence we only test +;;; the ECL_HANDLER_CASE. +;;; +(deftest embedding.0002.handlers + (let* ((c-code " +#include +#include + +int +main ( const int argc, const char * const argv [] ) +{ + cl_boot ( argc, (char **) argv ); + int result = 1; + + cl_env_ptr const environment = ecl_process_env (); + const cl_object const conditions = + ecl_list1 ( ecl_make_symbol ( \"DIVISION-BY-ZERO\", \"CL\" ) ); + + ECL_HANDLER_CASE_BEGIN ( environment, conditions ) { + ecl_divide ( ecl_make_fixnum ( 1 ), ecl_make_fixnum ( 0 ) ); + } ECL_HANDLER_CASE ( 1, condition ) { + result = 0; + } ECL_HANDLER_CASE_END; + + return result; +} +")) + (test-C-program c-code)) + T) diff --git a/src/tests/regressions/tests/mixed.lsp b/src/tests/regressions/tests/mixed.lsp index 049bcc75f..7213f2099 100644 --- a/src/tests/regressions/tests/mixed.lsp +++ b/src/tests/regressions/tests/mixed.lsp @@ -106,3 +106,20 @@ nil) + +;;; Date: 2016-05-21 (Masataro Asai) +;;; Description: +;;; +;;; RESTART-CASE investigates the body in an incorrect manner, +;;; then remove the arguments to SIGNAL, which cause the slots of +;;; the conditions to be not set properly. +;;; +;;; Bug: https://gitlab.com/embeddable-common-lisp/ecl/issues/247 +;;; +(ext:with-clean-symbols (x) + (define-condition x () ((y :initarg :y))) + (deftest mixed.0009.restart-case-body + (handler-bind ((x (lambda (c) (slot-value c 'y)))) + (restart-case + (signal 'x :y 1))) + nil))