Changes from arch/CVS synchronization

ChangeLog

@@ -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.

NEWS

@@ -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
 

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

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)

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

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

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;
 

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):

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"