diff --git a/ChangeLog b/ChangeLog index 9bf6a7876..ccaad8af1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-06-26 Ludovic Courtès + + * NEWS: Mention fixed memory leaks. + 2007-06-13 Ludovic Courtès * NEWS: Mention top-level define incompatible change. diff --git a/NEWS b/NEWS index 1ad52d7f0..c34afd187 100644 --- a/NEWS +++ b/NEWS @@ -41,6 +41,7 @@ This follows what it always did for "(* 0 inexact)". ** SRFI-19: Value returned by `(current-time time-process)' was incorrect ** `ttyname' no longer crashes when passed a non-tty argument ** `inet-ntop' no longer crashes on SPARC when passed an `AF_INET' address +** Small memory leaks have been fixed in `make-fluids' and `add-history' ** Build problems on Solaris fixed ** Build problems on Mingw fixed diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 5786a435c..0ede60ba4 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,8 @@ +2007-06-26 Ludovic Courtès + + * readline.c (scm_add_history): Free S after invocation of + `add_history ()'. + 2006-10-06 Rob Browning * LIBGUILEREADLINE-VERSION (LIBGUILEREADLINE_INTERFACE_REVISION): @@ -295,7 +300,7 @@ 2001-06-14 Marius Vollmer - Thanks to Matthias Köppe! + Thanks to Matthias Köppe! * configure.in: Check for rl_filename_completion_function. * readline.c (s_scm_filename_completion_function): Use @@ -681,3 +686,7 @@ Sun Dec 12 19:56:52 1999 Greg J. Badros * Started guile-readline package. Files are copied from old guile-core package and slightly modified. + +;; Local Variables: +;; coding: utf-8 +;; End: diff --git a/guile-readline/readline.c b/guile-readline/readline.c index 4eab67582..aa6c01409 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -1,6 +1,6 @@ /* readline.c --- line editing support for Guile */ -/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -329,6 +329,7 @@ SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0, s = scm_to_locale_string (text); add_history (s); + free (s); return SCM_UNSPECIFIED; } diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 426491634..535ba9c9d 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2007-06-26 Ludovic Courtès + + * fluids.c (next_fluid_num): When growing ALLOCATED_FLUIDS, make + sure to free the previous array after the new one has been + installed. This leak is made visible by running + "(define l (map (lambda (i) (make-fluid)) (iota 255)))" + from the REPL within Valgrind. + 2007-06-13 Ludovic Courtès * eval.c (scm_m_define): Updated comment. Changed order for value diff --git a/libguile/fluids.c b/libguile/fluids.c index ce2754822..eded07472 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007 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 @@ -226,7 +226,8 @@ next_fluid_num () no GC can run while updating these two variables. */ - char *new_allocated_fluids = + char *prev_allocated_fluids; + char *new_allocated_fluids = scm_malloc (allocated_fluids_len + FLUID_GROW); /* Copy over old values and initialize rest. GC can not run @@ -236,9 +237,14 @@ next_fluid_num () memcpy (new_allocated_fluids, allocated_fluids, allocated_fluids_len); memset (new_allocated_fluids + allocated_fluids_len, 0, FLUID_GROW); n = allocated_fluids_len; + + prev_allocated_fluids = allocated_fluids; allocated_fluids = new_allocated_fluids; allocated_fluids_len += FLUID_GROW; - + + if (prev_allocated_fluids != NULL) + free (prev_allocated_fluids); + /* Now allocated_fluids and allocated_fluids_len are valid again and we can allow GCs to occur. */ diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index e10759e83..8b5cadfc6 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2007-06-26 Ludovic Courtès + + * tests/socket.test (htonl): Only executed if `htonl' is defined. + (ntohl): Likewise. Reported by Marijn Schouten (hkBst) + . + 2007-06-13 Ludovic Courtès * tests/syntax.test (top-level define)[binding is created before diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test index ed8f5fc03..f5fc2be89 100644 --- a/test-suite/tests/socket.test +++ b/test-suite/tests/socket.test @@ -25,20 +25,21 @@ ;;; htonl ;;; -(with-test-prefix "htonl" +(if (defined? 'htonl) + (with-test-prefix "htonl" - (pass-if "0" (eqv? 0 (htonl 0))) + (pass-if "0" (eqv? 0 (htonl 0))) - (pass-if-exception "-1" exception:out-of-range - (htonl -1)) + (pass-if-exception "-1" exception:out-of-range + (htonl -1)) - ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect - ;; an overflow for values 2^32 <= x < 2^63 - (pass-if-exception "2^32" exception:out-of-range - (htonl (ash 1 32))) + ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect + ;; an overflow for values 2^32 <= x < 2^63 + (pass-if-exception "2^32" exception:out-of-range + (htonl (ash 1 32))) - (pass-if-exception "2^1024" exception:out-of-range - (htonl (ash 1 1024)))) + (pass-if-exception "2^1024" exception:out-of-range + (htonl (ash 1 1024))))) ;;; @@ -151,20 +152,21 @@ ;;; ntohl ;;; -(with-test-prefix "ntohl" +(if (defined? 'ntohl) + (with-test-prefix "ntohl" - (pass-if "0" (eqv? 0 (ntohl 0))) + (pass-if "0" (eqv? 0 (ntohl 0))) - (pass-if-exception "-1" exception:out-of-range - (ntohl -1)) + (pass-if-exception "-1" exception:out-of-range + (ntohl -1)) - ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect - ;; an overflow for values 2^32 <= x < 2^63 - (pass-if-exception "2^32" exception:out-of-range - (ntohl (ash 1 32))) + ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect + ;; an overflow for values 2^32 <= x < 2^63 + (pass-if-exception "2^32" exception:out-of-range + (ntohl (ash 1 32))) - (pass-if-exception "2^1024" exception:out-of-range - (ntohl (ash 1 1024)))) + (pass-if-exception "2^1024" exception:out-of-range + (ntohl (ash 1 1024)))))