diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | NEWS | 1 | ||||
| -rw-r--r-- | doc/ref/ChangeLog | 8 | ||||
| -rwxr-xr-x | doc/ref/api-data.texi | 12 | ||||
| -rw-r--r-- | doc/ref/api-modules.texi | 14 | ||||
| -rw-r--r-- | libguile/ChangeLog | 8 | ||||
| -rw-r--r-- | libguile/goops.c | 23 | ||||
| -rw-r--r-- | test-suite/ChangeLog | 4 | ||||
| -rw-r--r-- | test-suite/tests/goops.test | 33 |
9 files changed, 98 insertions, 9 deletions
@@ -1,3 +1,7 @@ +2007-07-11 Ludovic Courtès <ludo@gnu.org> + + * NEWS: Mention GOOPS `method-more-specific?' bug fix. + 2007-07-09 Ludovic Courtès <ludo@gnu.org> * NEWS: Mention SRFI-19 `date->julian-day' bug fix. @@ -57,6 +57,7 @@ This follows what it always did for "(* 0 inexact)". ** `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-fluid' and `add-history' +** GOOPS: Fixed a bug in `method-more-specific?' ** Build problems on Solaris fixed ** Build problems on Mingw fixed diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index e40839b6c..33e74bff1 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,11 @@ +2007-07-10 Ludovic Courtès <ludo@gnu.org> + + * api-data.texi (Arithmetic): Documented `1+' and `1-'. + Suggested by Jon Wilson <j85wilson@fastmail.fm>. + + * api-modules.texi (Module System Reflection): Documented + `save-module-excursion', by Jon Wilson <jsw@wilsonjc.us>. + 2007-06-07 Ludovic Courtès <ludovic.courtes@laas.fr> * api-control.texi (Dynamic Wind): Fixed typo. Reported by diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index df913b2cd..41bb9ac9c 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1117,6 +1117,8 @@ Returns the magnitude or angle of @var{z} as a @code{double}. @rnindex * @rnindex - @rnindex / +@findex 1+ +@findex 1- @rnindex abs @rnindex floor @rnindex ceiling @@ -1158,6 +1160,16 @@ Divide the first argument by the product of the remaining arguments. If called with one argument @var{z1}, 1/@var{z1} is returned. @end deffn +@deffn {Scheme Procedure} 1+ z +@deffnx {C Function} scm_oneplus (z) +Return @math{@var{z} + 1}. +@end deffn + +@deffn {Scheme Procedure} 1- z +@deffnx {C function} scm_oneminus (z) +Return @math{@var{z} - 1}. +@end deffn + @c begin (texi-doc-string "guile" "abs") @deffn {Scheme Procedure} abs x @deffnx {C Function} scm_abs (x) diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi index c12e31dca..415c9cba6 100644 --- a/doc/ref/api-modules.texi +++ b/doc/ref/api-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -602,6 +602,18 @@ Set the current module to @var{module} and return the previous current module. @end deffn +@deffn {Scheme Procedure} save-module-excursion thunk +Call @var{thunk} within a @code{dynamic-wind} such that the module that +is current at invocation time is restored when @var{thunk}'s dynamic +extent is left (@pxref{Dynamic Wind}). + +More precisely, if @var{thunk} escapes non-locally, the current module +(at the time of escape) is saved, and the original current module (at +the time @var{thunk}'s dynamic extent was last entered) is restored. If +@var{thunk}'s dynamic extent is re-entered, then the current module is +saved, and the previously saved inner module is set current again. +@end deffn + @deffn {Scheme Procedure} resolve-module name Find the module named @var{name} and return it. When it has not already been defined, try to auto-load it. When it can't be found that way diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 32631b660..340b64d1a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2007-07-11 Ludovic Courtès <ludo@gnu.org> + + * goops.c (scm_sys_method_more_specific_p): Added docstring. + Make sure LEN is greater than or equal to the minimum length of + specializers of M1 and M2. This fixes a segfault later on in + `more_specificp ()' if TARGS is too small. Reported by Marco + Maggi <marco.maggi-ipsu@poste.it>. + 2007-06-26 Ludovic Courtès <ludo@gnu.org> * fluids.c (next_fluid_num): When growing ALLOCATED_FLUIDS, make diff --git a/libguile/goops.c b/libguile/goops.c index 52ce76b72..9cebeb215 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -2315,29 +2315,36 @@ SCM_DEFINE (scm_find_method, "find-method", 0, 0, 1, SCM_DEFINE (scm_sys_method_more_specific_p, "%method-more-specific?", 3, 0, 0, (SCM m1, SCM m2, SCM targs), - "") + "Return true if method @var{m1} is more specific than @var{m2} " + "given the argument types (classes) listed in @var{targs}.") #define FUNC_NAME s_scm_sys_method_more_specific_p { SCM l, v, result; SCM *v_elts; - long i, len; + long i, len, m1_specs, m2_specs; scm_t_array_handle handle; SCM_VALIDATE_METHOD (1, m1); SCM_VALIDATE_METHOD (2, m2); - SCM_ASSERT ((len = scm_ilength (targs)) != -1, targs, SCM_ARG3, FUNC_NAME); - /* Verify that all the arguments of targs are classes and place them - in a vector - */ + len = scm_ilength (targs); + m1_specs = scm_ilength (SPEC_OF (m1)); + m2_specs = scm_ilength (SPEC_OF (m2)); + SCM_ASSERT ((len >= m1_specs) || (len >= m2_specs), + targs, SCM_ARG3, FUNC_NAME); + + /* Verify that all the arguments of TARGS are classes and place them + in a vector. */ v = scm_c_make_vector (len, SCM_EOL); v_elts = scm_vector_writable_elements (v, &handle, NULL, NULL); - for (i = 0, l = targs; i < len && scm_is_pair (l); i++, l = SCM_CDR (l)) + for (i = 0, l = targs; + i < len && scm_is_pair (l); + i++, l = SCM_CDR (l)) { SCM_ASSERT (SCM_CLASSP (SCM_CAR (l)), targs, SCM_ARG3, FUNC_NAME); - v_elts[i] = SCM_CAR(l); + v_elts[i] = SCM_CAR (l); } result = more_specificp (m1, m2, v_elts) ? SCM_BOOL_T: SCM_BOOL_F; diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 17bae3385..54232b6a2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2007-07-11 Ludovic Courtès <ludo@gnu.org> + + * tests/goops.test (defining methods): New test prefix. + 2007-07-09 Ludovic Courtès <ludo@gnu.org> * tests/srfi-19.test (`time-utc->julian-day' honors timezone): diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index dd61369c5..8ed697c59 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -177,6 +177,39 @@ (null? (generic-function-methods foo))) (current-module))))) +(with-test-prefix "defining methods" + + (pass-if "define-method" + (let ((m (current-module))) + (eval '(define-method (my-plus (s1 <string>) (s2 <string>)) + (string-append s1 s2)) + m) + (eval '(define-method (my-plus (i1 <integer>) (i2 <integer>)) + (+ i1 i2)) + m) + (eval '(and (is-a? my-plus <generic>) + (= (length (generic-function-methods my-plus)) + 2)) + m))) + + (pass-if "method-more-specific?" + (eval '(let* ((m+ (generic-function-methods my-plus)) + (m1 (car m+)) + (m2 (cadr m+)) + (arg-types (list <string> <string>))) + (if (memq <string> (method-specializers m1)) + (method-more-specific? m1 m2 arg-types) + (method-more-specific? m2 m1 arg-types))) + (current-module))) + + (pass-if-exception "method-more-specific? (failure)" + exception:wrong-type-arg + (eval '(let* ((m+ (generic-function-methods my-plus)) + (m1 (car m+)) + (m2 (cadr m+))) + (method-more-specific? m1 m2 '())) + (current-module)))) + (with-test-prefix "defining accessors" (with-test-prefix "define-accessor" |