bug#19459: #:export does not honor the merge-generics contract

[David Pirotte]

Hello,

        debian testing
          GNU Guile 2.0.11      [ mine is .10-fa1a3-dirty, but it does not 
matter
                                        [ i'm stuck in that version until goops 
is patched
                                        [ and compiles guile-gnome again...
            #:export does not honor the merge-generics contract

#:export should be adapted to honor the 'merge-generics user request and 
'contract'.

What ever forces the 'system' to create a generic function, #:export in this 
case,
when 'merge-generics has been set, the system should or use the imported 
generic and
add the newly locally defined method, or create a new one [if that is necessary 
for its
internal machinery] _but_ [immediately] merge it with th imported one, since it 
is
the user request.

Right now, even with the merge-generic setting, #:export calls
module-ensure-local-variable! before anything else, creates a new get-with
var, first unbound, later turned into a generic function with 1
applicable [locally defined] method only _but_ it does _not_not merge it, 
leading to "No
applicable method..." bugs, as in the following example [simple and stupid, but 
it
only partially mimics real case situation, see the image.scm attachment of this 
mail
if you're interested http://www.mail-archive.com/address@hidden/msg12618.html

Happy hacking,
David

;; module a starts here
(define-module (a)
  #:use-module (oop goops)
  #:export (<a>
            !width
            get-width
            set-width))


(define-class <a> ()
  (width #:accessor !width #:init-keyword #:width #:init-value 0))

(define-method (get-width (self <a>))
  (!width self))

(define-method (set-width (self <a>) width)
  (set! (!width self) width))
;;  module a ends here


;; module b starts here
(define-module (b)
  #:use-module (oop goops)
  #:use-module (a)
  #:export (<b>
            !width
            get-width
            set-width))


(define-class <b> ()
  (width #:accessor !width #:init-keyword #:width #:init-value 0))

(define-method (initialize (self <b>) initargs)
  (next-method)  
  (let ((a (make <a>)))
    (set-width self (get-width a))
    #;(add-child b a)))

(define-method (get-width (self <b>))
  (!width self))

(define-method (set-width (self <b>) width)
  (set! (!width self) width))
;;  module b ends here


scheme@(guile-user)> ,use (oop goops)
scheme@(guile-user)> (default-duplicate-binding-handler '(merge-generics 
replace warn-override-core warn last))
scheme@(guile-user)> ,use (b)
;;; note: source file ./b.scm
;;;       newer than compiled 
/home/david/.cache/guile/ccache/2.0-LE-8-2.0/usr/alto/projects/guile-tests/goops/export/b.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling ./b.scm
;;; compiled 
/home/david/.cache/guile/ccache/2.0-LE-8-2.0/usr/alto/projects/guile-tests/goops/export/b.scm.go
scheme@(guile-user)> (make <b>)
ERROR: In procedure scm-error:
ERROR: No applicable method for #<<generic> get-width (1)> in call (get-width 
#<<a> 2b70880>)

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,bt
In oop/goops.scm:
   1553:4  3 (#<procedure 2854c80 at oop/goops.scm:1551:0 (class . initargs)> 
#<<class> <b> 28cb8…>)
In guile-tests/goops/export/b.scm:
    17:20  2 (#<procedure 2b708e0 at guile-tests/goops/export/b.scm:14:0 (self 
initargs)> #<<…> …)
In oop/goops/dispatch.scm:
    239:9  1 (cache-miss #<<generic> get-width (1)> (#<<a> 2b70880>))
In unknown file:
           0 (scm-error goops-error #f "No applicable method for ~S in call ~S" 
(#<<generic> …> …) …)
scheme@(guile-user) [1]>

pgpfDlia_JGJ7.pgp
Description: OpenPGP digital signature