diff --git a/pkgs/development/interpreters/guile/default.nix b/pkgs/development/interpreters/guile/default.nix index 74808b8d9af..bb0a3f35086 100644 --- a/pkgs/development/interpreters/guile/default.nix +++ b/pkgs/development/interpreters/guile/default.nix @@ -4,11 +4,13 @@ stdenv.mkDerivation rec { name = "guile-1.8.4"; src = fetchurl { - url = "ftp://ftp.gnu.org/gnu/guile/" + name + ".tar.gz"; + url = "mirror://gnu/guile/" + name + ".tar.gz"; sha256 = "1cz1d4n6vzw0lfsvplsiarwqk675f12j596dzfv0h5r9cljpc0ya"; }; - patches = [ ./test-tmpdir.patch ]; + patches = [ ./test-tmpdir.patch + ./srcprop-no-deadlock.patch + ./popen-zombie.patch ]; buildInputs = [ makeWrapper ]; propagatedBuildInputs = [readline libtool gmp gawk]; @@ -17,10 +19,7 @@ stdenv.mkDerivation rec { wrapProgram $out/bin/guile-snarf --prefix PATH : "${gawk}/bin" ''; - # FIXME: It seems that we hit a deadlock sometimes when running the - # test suite, typically somewhere between `time.test' and - # `unit.test'. To be continued... - doCheck = false; + doCheck = true; setupHook = ./setup-hook.sh; diff --git a/pkgs/development/interpreters/guile/popen-zombie.patch b/pkgs/development/interpreters/guile/popen-zombie.patch new file mode 100644 index 00000000000..215c87a3a7b --- /dev/null +++ b/pkgs/development/interpreters/guile/popen-zombie.patch @@ -0,0 +1,45 @@ +Index: guile/test-suite/tests/popen.test +=================================================================== +RCS file: /sources/guile/guile/guile-core/guile/test-suite/tests/popen.test,v +retrieving revision 1.3.2.2 +diff -u -r1.3.2.2 popen.test +--- guile/test-suite/tests/popen.test 25 Aug 2006 01:21:39 -0000 1.3.2.2 ++++ guile/test-suite/tests/popen.test 18 Mar 2008 20:18:08 -0000 +@@ -1,6 +1,6 @@ + ;;;; popen.test --- exercise ice-9/popen.scm -*- scheme -*- + ;;;; +-;;;; Copyright 2003, 2006 Free Software Foundation, Inc. ++;;;; Copyright 2003, 2006, 2008 Free Software Foundation, Inc. + ;;;; + ;;;; This library is free software; you can redistribute it and/or + ;;;; modify it under the terms of the GNU Lesser General Public +@@ -81,12 +81,15 @@ + (let* ((pair (pipe)) + (port (with-error-to-port (cdr pair) + (lambda () +- (open-input-pipe +- "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999"))))) ++ (open-input-output-pipe ++ "exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; read"))))) + (close-port (cdr pair)) ;; write side +- (and (char? (read-char (car pair))) ;; wait for child to do its thing +- (char-ready? port) +- (eof-object? (read-char port)))))) ++ (let ((result (and (char? (read-char (car pair))) ;; wait for child to do its thing ++ (char-ready? port) ++ (eof-object? (read-char port))))) ++ (display "hello!\n" port) ++ (close-pipe port) ++ result)))) + + ;; + ;; open-output-pipe +@@ -132,7 +135,7 @@ + (port (with-error-to-port (cdr pair) + (lambda () + (open-output-pipe +- "exec 0&2; exec 2>/dev/null; sleep 999"))))) ++ "exec 0&2; exec 2>/dev/null; read"))))) + (close-port (cdr pair)) ;; write side + (and (char? (read-char (car pair))) ;; wait for child to do its thing + (catch 'system-error diff --git a/pkgs/development/interpreters/guile/srcprop-no-deadlock.patch b/pkgs/development/interpreters/guile/srcprop-no-deadlock.patch new file mode 100644 index 00000000000..26d10e07d17 --- /dev/null +++ b/pkgs/development/interpreters/guile/srcprop-no-deadlock.patch @@ -0,0 +1,288 @@ +Index: guile/libguile/eval.c +=================================================================== +RCS file: /sources/guile/guile/guile-core/guile/libguile/eval.c,v +retrieving revision 1.405.2.13 +diff -u -r1.405.2.13 eval.c +--- guile/libguile/eval.c 10 Mar 2008 22:13:33 -0000 1.405.2.13 ++++ guile/libguile/eval.c 13 Mar 2008 22:42:30 -0000 +@@ -3039,7 +3039,7 @@ + do { \ + SCM_SET_ARGSREADY (debug);\ + if (scm_check_apply_p && SCM_TRAPS_P)\ +- if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\ ++ if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && SCM_PROCTRACEP (proc)))\ + {\ + SCM tmp, tail = scm_from_bool(SCM_TRACED_FRAME_P (debug)); \ + SCM_SET_TRACED_FRAME (debug); \ +Index: guile/libguile/srcprop.c +=================================================================== +RCS file: /sources/guile/guile/guile-core/guile/libguile/srcprop.c,v +retrieving revision 1.73.2.1 +diff -u -r1.73.2.1 srcprop.c +--- guile/libguile/srcprop.c 12 Feb 2006 13:42:51 -0000 1.73.2.1 ++++ guile/libguile/srcprop.c 13 Mar 2008 22:42:30 -0000 +@@ -37,7 +37,7 @@ + /* {Source Properties} + * + * Properties of source list expressions. +- * Five of these have special meaning and optimized storage: ++ * Five of these have special meaning: + * + * filename string The name of the source file. + * copy list A copy of the list expression. +@@ -55,29 +55,47 @@ + SCM_GLOBAL_SYMBOL (scm_sym_column, "column"); + SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint"); + +-scm_t_bits scm_tc16_srcprops; +-static scm_t_srcprops_chunk *srcprops_chunklist = 0; +-static scm_t_srcprops *srcprops_freelist = 0; + + ++/* ++ * Source properties are stored as double cells with the ++ * following layout: ++ ++ * car = tag ++ * cbr = pos ++ * ccr = copy ++ * cdr = plist ++ */ ++ ++#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p))) ++#define SRCPROPBRK(p) (SCM_SMOB_FLAGS (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK) ++#define SRCPROPPOS(p) (SCM_CELL_WORD(p,1)) ++#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) ++#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) ++#define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2)) ++#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p)) ++#define SETSRCPROPBRK(p) \ ++ (SCM_SET_SMOB_FLAGS ((p), \ ++ SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK)) ++#define CLEARSRCPROPBRK(p) \ ++ (SCM_SET_SMOB_FLAGS ((p), \ ++ SCM_SMOB_FLAGS (p) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) ++#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) ++#define SETSRCPROPPOS(p, l, c) (SCM_SET_CELL_WORD(p,1, SRCPROPMAKPOS (l, c))) ++#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) ++#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) ++ ++ ++ ++scm_t_bits scm_tc16_srcprops; ++ + static SCM + srcprops_mark (SCM obj) + { +- scm_gc_mark (SRCPROPFNAME (obj)); + scm_gc_mark (SRCPROPCOPY (obj)); + return SRCPROPPLIST (obj); + } + +- +-static size_t +-srcprops_free (SCM obj) +-{ +- *((scm_t_srcprops **) SCM_SMOB_DATA (obj)) = srcprops_freelist; +- srcprops_freelist = (scm_t_srcprops *) SCM_SMOB_DATA (obj); +- return 0; /* srcprops_chunks are not freed until leaving guile */ +-} +- +- + static int + srcprops_print (SCM obj, SCM port, scm_print_state *pstate) + { +@@ -99,38 +117,45 @@ + } + + ++/* ++ * We remember the last file name settings, so we can share that plist ++ * entry. This works because scm_set_source_property_x does not use ++ * assoc-set! for modifying the plist. ++ * ++ * This variable contains a protected cons, whose cdr is the cached ++ * plist ++ */ ++static SCM scm_last_plist_filename; ++ + SCM + scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist) + { +- register scm_t_srcprops *ptr; +- SCM_CRITICAL_SECTION_START; +- if ((ptr = srcprops_freelist) != NULL) +- srcprops_freelist = *(scm_t_srcprops **)ptr; +- else ++ if (!SCM_UNBNDP (filename)) + { +- size_t i; +- scm_t_srcprops_chunk *mem; +- size_t n = sizeof (scm_t_srcprops_chunk) +- + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1); +- SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) scm_malloc (n)); +- if (mem == NULL) +- scm_memory_error ("srcprops"); +- scm_gc_register_collectable_memory (mem, n, "srcprops"); +- +- mem->next = srcprops_chunklist; +- srcprops_chunklist = mem; +- ptr = &mem->srcprops[0]; +- for (i = 1; i < SRCPROPS_CHUNKSIZE - 1; ++i) +- *(scm_t_srcprops **)&ptr[i] = &ptr[i + 1]; +- *(scm_t_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0; +- srcprops_freelist = (scm_t_srcprops *) &ptr[1]; ++ SCM old_plist = plist; ++ ++ /* ++ have to extract the acons, and operate on that, for ++ thread safety. ++ */ ++ SCM last_acons = SCM_CDR (scm_last_plist_filename); ++ if (old_plist == SCM_EOL ++ && SCM_CDAR (last_acons) == filename) ++ { ++ plist = last_acons; ++ } ++ else ++ { ++ plist = scm_acons (scm_sym_filename, filename, plist); ++ if (old_plist == SCM_EOL) ++ SCM_SETCDR (scm_last_plist_filename, plist); ++ } + } +- ptr->pos = SRCPROPMAKPOS (line, col); +- ptr->fname = filename; +- ptr->copy = copy; +- ptr->plist = plist; +- SCM_CRITICAL_SECTION_END; +- SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr); ++ ++ SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops, ++ SRCPROPMAKPOS (line, col), ++ copy, ++ plist); + } + + +@@ -140,8 +165,6 @@ + SCM plist = SRCPROPPLIST (obj); + if (!SCM_UNBNDP (SRCPROPCOPY (obj))) + plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist); +- if (!SCM_UNBNDP (SRCPROPFNAME (obj))) +- plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist); + plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist); + plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist); + plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), plist); +@@ -206,7 +229,6 @@ + if (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK (p)); + else if (scm_is_eq (scm_sym_line, key)) p = scm_from_int (SRCPROPLINE (p)); + else if (scm_is_eq (scm_sym_column, key)) p = scm_from_int (SRCPROPCOL (p)); +- else if (scm_is_eq (scm_sym_filename, key)) p = SRCPROPFNAME (p); + else if (scm_is_eq (scm_sym_copy, key)) p = SRCPROPCOPY (p); + else + { +@@ -277,13 +299,6 @@ + scm_make_srcprops (0, scm_to_int (datum), + SCM_UNDEFINED, SCM_UNDEFINED, p)); + } +- else if (scm_is_eq (scm_sym_filename, key)) +- { +- if (SRCPROPSP (p)) +- SRCPROPFNAME (p) = datum; +- else +- SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, SCM_UNDEFINED, p)); +- } + else if (scm_is_eq (scm_sym_copy, key)) + { + if (SRCPROPSP (p)) +@@ -308,29 +323,18 @@ + { + scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0); + scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark); +- scm_set_smob_free (scm_tc16_srcprops, srcprops_free); + scm_set_smob_print (scm_tc16_srcprops, srcprops_print); + + scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047)); + scm_c_define ("source-whash", scm_source_whash); + ++ scm_last_plist_filename ++ = scm_permanent_object (scm_cons (SCM_EOL, ++ scm_acons (SCM_EOL, SCM_EOL, SCM_EOL))); ++ + #include "libguile/srcprop.x" + } + +-void +-scm_finish_srcprop () +-{ +- register scm_t_srcprops_chunk *ptr = srcprops_chunklist, *next; +- size_t n= sizeof (scm_t_srcprops_chunk) +- + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1); +- while (ptr) +- { +- next = ptr->next; +- scm_gc_unregister_collectable_memory (ptr, n, "srcprops"); +- free ((char *) ptr); +- ptr = next; +- } +-} + + /* + Local Variables: +Index: guile/libguile/srcprop.h +=================================================================== +RCS file: /sources/guile/guile/guile-core/guile/libguile/srcprop.h,v +retrieving revision 1.36.2.1 +diff -u -r1.36.2.1 srcprop.h +--- guile/libguile/srcprop.h 12 Feb 2006 13:42:51 -0000 1.36.2.1 ++++ guile/libguile/srcprop.h 13 Mar 2008 22:42:30 -0000 +@@ -49,46 +49,10 @@ + + /* {Source properties} + */ +- +-SCM_API scm_t_bits scm_tc16_srcprops; +- +-typedef struct scm_t_srcprops +-{ +- unsigned long pos; +- SCM fname; +- SCM copy; +- SCM plist; +-} scm_t_srcprops; +- +-#define SRCPROPS_CHUNKSIZE 2047 /* Number of srcprops per chunk */ +-typedef struct scm_t_srcprops_chunk +-{ +- struct scm_t_srcprops_chunk *next; +- scm_t_srcprops srcprops[1]; +-} scm_t_srcprops_chunk; +- ++#define SCM_PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace))) + #define SCM_SOURCE_PROPERTY_FLAG_BREAK 1 + +-#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p))) +-#define SRCPROPBRK(p) (SCM_SMOB_FLAGS (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK) +-#define SRCPROPPOS(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->pos +-#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12) +-#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL) +-#define SRCPROPFNAME(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->fname +-#define SRCPROPCOPY(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->copy +-#define SRCPROPPLIST(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->plist +-#define SETSRCPROPBRK(p) \ +- (SCM_SET_SMOB_FLAGS ((p), \ +- SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK)) +-#define CLEARSRCPROPBRK(p) \ +- (SCM_SET_SMOB_FLAGS ((p), \ +- SCM_SMOB_FLAGS (p) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK)) +-#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c)) +-#define SETSRCPROPPOS(p, l, c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c)) +-#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p)) +-#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c) +- +-#define PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace))) ++SCM_API scm_t_bits scm_tc16_srcprops; + + SCM_API SCM scm_sym_filename; + SCM_API SCM scm_sym_copy;