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

[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  <address@hidden>

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