diff --git a/ChangeLog b/ChangeLog index 8c15dca4a..1cf48f397 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-06-26 Ludovic Courtès + + * NEWS: Mention fixed memory leaks. + 2007-06-12 Ludovic Courtès * NEWS: Mention `inet-ntop' bug fix. diff --git a/NEWS b/NEWS index 1b51e6fcb..ec7f7c31c 100644 --- a/NEWS +++ b/NEWS @@ -55,6 +55,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 51979c783..b6797b489 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 ()'. + 2007-01-19 Han-Wen Nienhuys * readline.c: terminate option list with NULL. @@ -315,7 +320,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 @@ -701,3 +706,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 4d2be7302..5a8ced64a 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 d97036ac3..32631b660 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-12 Ludovic Courtès * socket.c (scm_inet_ntop): In the `AF_INET' case, declare `addr4' 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 dbd3fc714..e611e73c2 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-12 Ludovic Courtès * tests/socket.test: Renamed module to `(test-suite test-socket)'. 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)))))