From 48e2c94ba29c55ba14d58fceb3f6dc55329fe01e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 10 Jul 2007 22:39:36 +0000 Subject: [PATCH] Changes from arch/CVS synchronization --- ChangeLog | 4 ++++ NEWS | 1 + doc/ref/ChangeLog | 8 ++++++++ doc/ref/api-data.texi | 12 ++++++++++++ doc/ref/api-modules.texi | 14 +++++++++++++- libguile/ChangeLog | 8 ++++++++ libguile/goops.c | 23 +++++++++++++++-------- test-suite/ChangeLog | 4 ++++ test-suite/tests/goops.test | 33 +++++++++++++++++++++++++++++++++ 9 files changed, 98 insertions(+), 9 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9c8792848..544ef33f4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2007-07-11 Ludovic Courtès + + * NEWS: Mention GOOPS `method-more-specific?' bug fix. + 2007-07-09 Ludovic Courtès * NEWS: Mention SRFI-19 `date->julian-day' bug fix. diff --git a/NEWS b/NEWS index 1ef555858..fb9a16aeb 100644 --- a/NEWS +++ b/NEWS @@ -43,6 +43,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 17b58a02a..ab059715a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,11 @@ +2007-07-10 Ludovic Courtès + + * api-data.texi (Arithmetic): Documented `1+' and `1-'. + Suggested by Jon Wilson . + + * api-modules.texi (Module System Reflection): Documented + `save-module-excursion', by Jon Wilson . + 2007-06-07 Ludovic Courtès * api-control.texi (Dynamic Wind): Fixed typo. Reported by diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 9e3f5d36b..93692fa70 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -1111,6 +1111,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 @@ -1152,6 +1154,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 535ba9c9d..6bcf31b15 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2007-07-11 Ludovic Courtès + + * 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 . + 2007-06-26 Ludovic Courtès * 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 a18715bcb..1bfb82550 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2007-07-11 Ludovic Courtès + + * tests/goops.test (defining methods): New test prefix. + 2007-07-09 Ludovic Courtès * 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 ) (s2 )) + (string-append s1 s2)) + m) + (eval '(define-method (my-plus (i1 ) (i2 )) + (+ i1 i2)) + m) + (eval '(and (is-a? my-plus ) + (= (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 ))) + (if (memq (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"