Hello,

         [ writing a 'pure' guile/goops code, not using guile-gnome
         [ guile-clutter is left as an exercise :)

In the attached code [image.scm], uncommenting line 43 [commenting
line 49] would raise the following bug (1).

Imo, it should not: the module system, #:export, should be goops
'aware' and not 'hide', as a side effect, imported generic functions
and methods.  Because #:export calls module-ensure-local-variable!,
before anything else, a new get-with var is created, first unbound,
later turned into a generic function with 1 applicable [locally defined]
method only, hiding imported functionality the module relies on.

Note that the initialize method redefinition is not even (re)exported,
so we are talking about guile breaking the code it runs within the 
module 'space' itself, which is not acceptable. Even though, as some
guile maintainers think it should [i don't, but that's another subject],
using #:export should indeed create a new generic function with the
locally defined applicable method only, it should do so for export purposes,
only, for modules that will use 'this one': it should not break upon executing
(get-with pixbuf), since (gnome gw gdk), imported, provides the functionality
it needs.

If anyone is interested, see g-export [goops export] code  [attached] I wrote
to circumvent this problem.


Happy hacking,
David

;; --

(1) the bug report

;;; compiling ./clus/image.scm
;;; compiled 
/home/david/.cache/guile/ccache/2.0-LE-8-2.0/usr/alto/projects/clutter/1.12/clus/image.scm.go
Backtrace:
In ice-9/boot-9.scm:
 157: 10 [catch #t #<catch-closure 152e9e0> ...]
In unknown file:
   ?: 9 [apply-smob/1 #<catch-closure 152e9e0>]
In ice-9/boot-9.scm:
  63: 8 [call-with-prompt prompt0 ...]
In ice-9/eval.scm:
 432: 7 [eval # #]
In clutter/1.12/toolbar:
  81: 6 [main ("./toolbar" "-d")]
In oop/goops.scm:
1553: 5 [#<procedure 19879c0 at oop/goops.scm:1551:0 (class . initargs)> # # 
...]
In clutter/1.12/clus/toolbar.scm:
 141: 4 [#<procedure 1e6a1c0 at clutter/1.12/clus/toolbar.scm:139:0 (self 
initargs)> # ...]
In oop/goops.scm:
1553: 3 [#<procedure 19879c0 at oop/goops.scm:1551:0 (class . initargs)> # # 
...]
In clutter/1.12/clus/image.scm:
  82: 2 [#<procedure 1e6fc80 at clutter/1.12/clus/image.scm:75:0 (self 
initargs)> # ...]
In oop/goops/dispatch.scm:
 239: 1 [cache-miss #<<generic> get-width (1)> (#<<gdk-pixbuf> 1e6fa00>)]
In unknown file:
   ?: 0 [scm-error goops-error #f ...]

ERROR: In procedure scm-error:
ERROR: No applicable method for #<<generic> get-width (1)> in call (get-width 
#<<gdk-pixbuf> 1e6fa00>)
david@capac:~/alto/projects/clutter/1.12 174 $ 

;; -*- mode: scheme; coding: utf-8 -*-

;;;; Copyright (C) 2014
;;;; Free Software Foundation, Inc.

;;;; This file is part of the guile-clutter examples set.

;;;; Guile-clutter examples set is free software: you can redistribute
;;;; it and/or modify it under the terms of the GNU General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.

;;;; Guile-clutter examples set is distributed in the hope that it
;;;; will be useful WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; General Public License for more details.

;;;; You should have received a copy of the GNU General Public License
;;;; along with the guile-clutter examples set.  If not, see
;;;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;;       <- stands for ->
;; clue                   clutter example
;; clues                  clutter examples set
;; clus                   clutter support

;;; Code:


(define-module (clus image)
  #:use-module (ice-9 receive)
  #:use-module (oop goops)
  #:use-module (gnome-2)
  #:use-module (gnome gobject)
  #:use-module (gnome glib)
  #:use-module (gnome gw gdk)  ;; gdk-pixbuf
  #:use-module (gnome clutter)
  #:use-module (clus utils)

  #:export (<clus-image>
	    #;get-width))


(g-export !filename
	  !pixbuf

	  get-width
	  get-height
	  get-size)


(define-class <clus-image> (<clutter-image>)
  (filename #:accessor !filename #:init-keyword #:filename #:init-value #f)
  (pixbuf #:accessor !pixbuf #:init-keyword #:pixbuf #:init-value #f))

(define-method (initialize (self <clus-image>) initargs)
  (next-method)
  (let ((pixbuf (gdk-pixbuf-new-from-file (!filename self))))
    (set! (!pixbuf self) pixbuf)
    (set-data self
	      (get-pixels pixbuf)
	      (if (get-has-alpha pixbuf) 'rgba-8888 'rgb-888)
	      (get-width pixbuf)
	      (get-height pixbuf)
	      (get-rowstride pixbuf))
    self))

(define-method (get-width (self <clus-image>))
  (get-width (!pixbuf self)))

(define-method (get-height (self <clus-image>))
  (get-height (!pixbuf self)))

(define-method (get-size (self <clus-image>))
  (let ((pixbuf (!pixbuf self)))
    (values (get-width pixbuf) (get-height pixbuf))))
;; -*- mode: scheme; coding: utf-8 -*-

;;;; Copyright (C) 2014
;;;; Free Software Foundation, Inc.

;;;; This file is part of the guile-clutter examples set.

;;;; Guile-clutter examples set is free software: you can redistribute
;;;; it and/or modify it under the terms of the GNU General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.

;;;; Guile-clutter examples set is distributed in the hope that it
;;;; will be useful WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; General Public License for more details.

;;;; You should have received a copy of the GNU General Public License
;;;; along with the guile-clutter examples set.  If not, see
;;;; <http://www.gnu.org/licenses/>.

;;; Commentary:

;;       <- stands for ->
;; clue                   clutter example
;; clues                  clutter examples set
;; clus                   clutter support

;;; Code:


(define-module (g-export)
  #:use-module (oop goops)

  #:export (module-g-export!
	    g-export))

(define (module-g-export! m names)
  (unless (memq 'merge-generics
		(default-duplicate-binding-handler))
    (display "Warning: you are using g-export [goops export, which re-export defined
names and should only be used for accessors, getters, setters and
methods], but you did not ask to merge duplicate generic functions:
unless you really know what you are doing, you should.\n"
	     (current-output-port)))
  (let ((public-i (module-public-interface m)))
    (for-each (lambda (name)
                (let* ((internal-name (if (pair? name) (car name) name))
                       (external-name (if (pair? name) (cdr name) name))
                       (var (module-variable m internal-name)))
		  (if var
		      (module-add! public-i external-name var)
		      (module-add! public-i external-name
				   (module-ensure-local-variable! m internal-name)))))
	names)))

(define-syntax-rule (g-export name ...)
  (eval-when (expand load eval)
    (call-with-deferred-observers
     (lambda ()
       (module-g-export! (current-module) '(name ...))))))

Attachment: pgpIdl4ZE8iqr.pgp
Description: OpenPGP digital signature

Reply via email to