[PATCH] Fix for `make-autoload-interface'

[ludovic.courtes@laas.fr (Ludovic Courtès)]

Hi,

Below is a patch that fixes a bug encountered in the following case,
along with a new test case.  Here is the problem:

  $ guile
  guile> (define-module (chbouib)
           :autoload (srfi srfi-39) (make-parameter)
           :use-module (srfi srfi-39))
  ERROR: In procedure set-car!:
  ERROR: Wrong type argument in position 1 (expecting pair): #f
  ABORT: (wrong-type-arg)

The `set-car!' here is the one used in the binder procedure produced by
`make-autoload-interface'.  This problem occurs because when resolving
duplicated between the autoload interface and the used interface (which
both export `make-parameter'), `make-parameter' is accessed from the
autoload interface more than once: the first time, `set-car!' works fine
(removing the autoload interface from the module's "uses"), but it fails
the second time.

The fix below is simple but I think it's the right way to solve this.

Thanks,
Ludovic.


2006-02-27  Ludovic Courtès  <ludovic.courtes@laas.fr>

	* ice-9/boot-9.scm (make-autoload-interface): Don't call
	`set-car!' if the autoload interface has already been removed
	from MODULE's uses.  This bug showed up when using a given
	module both with `autoload' and `use-module'.

	* test-suite/tests/module-autoload.test: New.

	* test-suite/Makefile.am (SCM_TESTS): Added `module-autoload.test'.
 

--- orig/ice-9/boot-9.scm
+++ mod/ice-9/boot-9.scm
@@ -2136,8 +2136,11 @@
 		  (let ((i (module-public-interface (resolve-module name))))
 		    (if (not i)
 			(error "missing interface for module" name))
-		    ;; Replace autoload-interface with interface
-		    (set-car! (memq a (module-uses module)) i)
+		    (let ((autoload (memq a (module-uses module))))
+		      ;; Replace autoload-interface with actual interface if
+		      ;; that has not happened yet.
+		      (if (pair? autoload)
+			  (set-car! autoload i)))
 		    (module-local-variable i sym))))))
     (module-constructor (make-hash-table 0) '() b #f #f name 'autoload #f #f
 			'() (make-weak-value-hash-table 31) 0)))


--- orig/test-suite/Makefile.am
+++ mod/test-suite/Makefile.am
@@ -46,6 +46,7 @@
 	    tests/interp.test			\
 	    tests/list.test			\
 	    tests/load.test			\
+	    tests/module-autoload.test		\
 	    tests/multilingual.nottest		\
 	    tests/numbers.test			\
 	    tests/optargs.test			\



test-suite/tests/module-autoload.test

;;;; module-autoload.test --- test guile's module autoloading  -*- scheme -*-
;;;; Copyright (C) 2006 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
;;;; License as published by the Free Software Foundation; either
;;;; version 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(use-modules (test-suite lib))


(with-test-prefix "autoload"

  (pass-if "autoloaded"
     (catch #t
       (lambda ()
	 ;; Simple autoloading.
	 (eval '(begin
		  (define-module (test-autoload-one)
		    :autoload (srfi srfi-19) (time-utc))

		  (not (not time-utc)))
	       (current-module)))
	(lambda (key . args)
	  #f)))

  (pass-if "autoloaded+used"
     (catch #t
       (lambda ()
	 ;; This special case used to fail because the binder used in
	 ;; `make-autoload-interface' would try to remove the autoload
	 ;; interface from the module's "uses" without making sure it is
	 ;; still part of these "uses".
	 (eval '(begin
		  (define-module (test-autoload-one)
		    :autoload (srfi srfi-19) (time-utc)
		    :use-module (srfi srfi-19))

		  (not (not time-utc)))
	       (current-module)))
	(lambda (key . args)
	  #f))))



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel