* possible goops class redefinition bug
@ 2002-03-15 8:11 Neil W. Van Dyke
2002-04-24 20:50 ` Marius Vollmer
0 siblings, 1 reply; 3+ messages in thread
From: Neil W. Van Dyke @ 2002-03-15 8:11 UTC (permalink / raw)
Unless I'm making a stupid late-night error, there appears to be a bug
related to Goops class redefinition in Guile 1.5.6 from CVS...
Under some circumstances of class redefinition, some slot accessors
subsequently work incorrectly both for instances instantiated *before*
the class redefinition and also for those instantiated *after* the
redefinition.
The following scenario shows class <c> with slot s1 being redefined to
have slots s0 and s1 (in that order):
(define <c> #f)
(define o1 #f)
(define o2 #f)
(define-class <c> ()
(s1 #:init-value 'c1-s1 #:getter a-s1))
(set! o1 (make <c>))
(slot-ref o1 's1) => c1-s1
(a-s1 o1) => c1-s1
(define-class <c> ()
(s0 #:init-value 'c2-s0 #:getter a-s0)
(s1 #:init-value 'c2-s1 #:getter a-s1))
(slot-ref o1 's1) => c1-s1 ;; Correct.
(a-s1 o1) => c2-s0 ;; *ERROR* Should be: c1-s1
(set! o2 (make <c>))
(slot-ref o2 's1) => c2-s1 ;; Correct.
(a-s1 o2) => c2-s0 ;; *ERROR* Should be: c2-s1
The following test program reproduces this behavior (along with
debugging information).
(use-modules (oop goops)
(oop goops describe))
(define (dump-gf gf . args)
(newline)
(format #t "DUMP OF GENERIC ~S FOR ARGS ~S:\n" gf args)
(let ((methods (compute-applicable-methods gf args)))
(format #t " Applicable: ~S\n" methods)
(format #t " Sorted: ~S\n"
(sort-applicable-methods gf methods args))))
(define <c> #f)
(define o1 #f)
(define o2 #f)
(newline)
(display "(define-class <c> ...)\n")
(define-class <c> ()
(s1 #:init-value 'c1-s1 #:getter a-s1))
(format #t "<c> => ~S\n" <c>)
(newline)
(format #t "(class-slots <c>)\n=> ~S\n"
(class-slots <c>))
(newline)
(format #t "(class-direct-methods <c>)\n=> ~S\n"
(class-direct-methods <c>))
(newline)
(format #t "a-s1 => ~S\n"
a-s1)
(newline)
(format #t "(generic-function-methods a-s1)\n=> ~S\n"
(generic-function-methods a-s1))
(newline)
(map (lambda (m) (format #t "(method-source ~S)\n=> ~S\n"
m (method-source m)))
(generic-function-methods a-s1))
(newline)
(display "(set! o1 (make <c>))\n")
(set! o1 (make <c>))
(newline)
(format #t "o1 => ~S\n"
o1)
(format #t "(class-of o1) => ~S\n"
(class-of o1))
(format #t "(slot-ref o1 's1) => ~S ; c1-s1 [OK]\n"
(slot-ref o1 's1))
(format #t "(a-s1 o1) => ~S ; c1-s1 [OK]\n"
(a-s1 o1))
; (display "(describe o1) :-\n")
; (describe o1)
(dump-gf a-s1 o1)
(newline)
(display "(define-class <c> ...)\n")
(define-class <c> ()
(s0 #:init-value 'c2-s0 #:getter a-s0)
(s1 #:init-value 'c2-s1 #:getter a-s1))
(format #t "<c> => ~S\n" <c>)
(newline)
(format #t "(class-slots <c>)\n=> ~S\n"
(class-slots <c>))
(newline)
(format #t "(class-direct-methods <c>)\n=> ~S\n"
(class-direct-methods <c>))
(newline)
; (format #t "a-s0 => ~S\n"
; a-s0)
(format #t "a-s1 => ~S\n"
a-s1)
(newline)
(format #t "(generic-function-methods a-s1)\n=> ~S\n"
(generic-function-methods a-s1))
(newline)
(map (lambda (m) (format #t "(method-source ~S)\n=> ~S\n"
m (method-source m)))
(generic-function-methods a-s1))
(newline)
(display "(set! o2 (make <c>))\n")
(set! o2 (make <c>))
(newline)
(format #t "o1 => ~S\n"
o1)
(format #t "(class-of o1) => ~S\n"
(class-of o1))
; (format #t "(slot-ref o1 's0) => ~S ; c2-s0 [OK]\n"
; (slot-ref o1 's0))
(format #t "(slot-ref o1 's1) => ~S ; c1-s1 [OK]\n"
(slot-ref o1 's1))
; (format #t "(a-s0 o1) => ~S ; c2-s0 [OK]\n"
; (a-s0 o1))
(format #t "(a-s1 o1) => ~S ; c1-s1 ***ERROR***\n"
(a-s1 o1))
; (display "(describe o1) :-\n")
; (describe o1)
(newline)
(format #t "o2 => ~S\n"
o2)
(format #t "(class-of o2) => ~S\n"
(class-of o2))
; (format #t "(slot-ref o2 's0) => ~S ; c2-s0 [OK]\n"
; (slot-ref o2 's0))
(format #t "(slot-ref o2 's1) => ~S ; c2-s1 [OK]\n"
(slot-ref o2 's1))
; (format #t "(a-s0 o2) => ~S ; c2-s0 [OK]\n"
; (a-s0 o2))
(format #t "(a-s1 o2) => ~S ; c2-s1 ***ERROR***\n"
(a-s1 o2))
; (display "(describe o2) :-\n")
; (describe o2)
(dump-gf a-s1 o1)
(dump-gf a-s1 o2)
--
Neil W. Van Dyke
http://www.neilvandyke.org/
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile
^ permalink raw reply [flat|nested] 3+ messages in thread* Re: possible goops class redefinition bug
@ 2003-04-20 11:35 Mikael Djurfeldt
0 siblings, 0 replies; 3+ messages in thread
From: Mikael Djurfeldt @ 2003-04-20 11:35 UTC (permalink / raw)
Cc: djurfeldt
"Neil W. Van Dyke" <nwv@neilvandyke.org> writes:
> Unless I'm making a stupid late-night error, there appears to be a bug
> related to Goops class redefinition in Guile 1.5.6 from CVS...
>
> Under some circumstances of class redefinition, some slot accessors
> subsequently work incorrectly both for instances instantiated *before*
> the class redefinition and also for those instantiated *after* the
> redefinition.
This bug has been fixed. Since there has passed over a year since you
committed the bug post, I include the rest of your report below.
Thank you!
> The following scenario shows class <c> with slot s1 being redefined to
> have slots s0 and s1 (in that order):
>
> (define <c> #f)
> (define o1 #f)
> (define o2 #f)
>
> (define-class <c> ()
> (s1 #:init-value 'c1-s1 #:getter a-s1))
>
> (set! o1 (make <c>))
>
> (slot-ref o1 's1) => c1-s1
> (a-s1 o1) => c1-s1
>
> (define-class <c> ()
> (s0 #:init-value 'c2-s0 #:getter a-s0)
> (s1 #:init-value 'c2-s1 #:getter a-s1))
>
> (slot-ref o1 's1) => c1-s1 ;; Correct.
> (a-s1 o1) => c2-s0 ;; *ERROR* Should be: c1-s1
>
> (set! o2 (make <c>))
>
> (slot-ref o2 's1) => c2-s1 ;; Correct.
> (a-s1 o2) => c2-s0 ;; *ERROR* Should be: c2-s1
>
> The following test program reproduces this behavior (along with
> debugging information).
>
> (use-modules (oop goops)
> (oop goops describe))
>
> (define (dump-gf gf . args)
> (newline)
> (format #t "DUMP OF GENERIC ~S FOR ARGS ~S:\n" gf args)
> (let ((methods (compute-applicable-methods gf args)))
> (format #t " Applicable: ~S\n" methods)
> (format #t " Sorted: ~S\n"
> (sort-applicable-methods gf methods args))))
>
> (define <c> #f)
> (define o1 #f)
> (define o2 #f)
>
> (newline)
> (display "(define-class <c> ...)\n")
> (define-class <c> ()
> (s1 #:init-value 'c1-s1 #:getter a-s1))
> (format #t "<c> => ~S\n" <c>)
>
> (newline)
> (format #t "(class-slots <c>)\n=> ~S\n"
> (class-slots <c>))
>
> (newline)
> (format #t "(class-direct-methods <c>)\n=> ~S\n"
> (class-direct-methods <c>))
>
> (newline)
> (format #t "a-s1 => ~S\n"
> a-s1)
>
> (newline)
> (format #t "(generic-function-methods a-s1)\n=> ~S\n"
> (generic-function-methods a-s1))
>
> (newline)
> (map (lambda (m) (format #t "(method-source ~S)\n=> ~S\n"
> m (method-source m)))
> (generic-function-methods a-s1))
>
> (newline)
> (display "(set! o1 (make <c>))\n")
> (set! o1 (make <c>))
>
> (newline)
> (format #t "o1 => ~S\n"
> o1)
> (format #t "(class-of o1) => ~S\n"
> (class-of o1))
> (format #t "(slot-ref o1 's1) => ~S ; c1-s1 [OK]\n"
> (slot-ref o1 's1))
> (format #t "(a-s1 o1) => ~S ; c1-s1 [OK]\n"
> (a-s1 o1))
> ; (display "(describe o1) :-\n")
> ; (describe o1)
>
> (dump-gf a-s1 o1)
>
> (newline)
> (display "(define-class <c> ...)\n")
> (define-class <c> ()
> (s0 #:init-value 'c2-s0 #:getter a-s0)
> (s1 #:init-value 'c2-s1 #:getter a-s1))
> (format #t "<c> => ~S\n" <c>)
>
> (newline)
> (format #t "(class-slots <c>)\n=> ~S\n"
> (class-slots <c>))
>
> (newline)
> (format #t "(class-direct-methods <c>)\n=> ~S\n"
> (class-direct-methods <c>))
>
> (newline)
> ; (format #t "a-s0 => ~S\n"
> ; a-s0)
> (format #t "a-s1 => ~S\n"
> a-s1)
>
> (newline)
> (format #t "(generic-function-methods a-s1)\n=> ~S\n"
> (generic-function-methods a-s1))
>
> (newline)
> (map (lambda (m) (format #t "(method-source ~S)\n=> ~S\n"
> m (method-source m)))
> (generic-function-methods a-s1))
>
> (newline)
> (display "(set! o2 (make <c>))\n")
> (set! o2 (make <c>))
>
> (newline)
> (format #t "o1 => ~S\n"
> o1)
> (format #t "(class-of o1) => ~S\n"
> (class-of o1))
> ; (format #t "(slot-ref o1 's0) => ~S ; c2-s0 [OK]\n"
> ; (slot-ref o1 's0))
> (format #t "(slot-ref o1 's1) => ~S ; c1-s1 [OK]\n"
> (slot-ref o1 's1))
> ; (format #t "(a-s0 o1) => ~S ; c2-s0 [OK]\n"
> ; (a-s0 o1))
> (format #t "(a-s1 o1) => ~S ; c1-s1 ***ERROR***\n"
> (a-s1 o1))
> ; (display "(describe o1) :-\n")
> ; (describe o1)
>
> (newline)
> (format #t "o2 => ~S\n"
> o2)
> (format #t "(class-of o2) => ~S\n"
> (class-of o2))
> ; (format #t "(slot-ref o2 's0) => ~S ; c2-s0 [OK]\n"
> ; (slot-ref o2 's0))
> (format #t "(slot-ref o2 's1) => ~S ; c2-s1 [OK]\n"
> (slot-ref o2 's1))
> ; (format #t "(a-s0 o2) => ~S ; c2-s0 [OK]\n"
> ; (a-s0 o2))
> (format #t "(a-s1 o2) => ~S ; c2-s1 ***ERROR***\n"
> (a-s1 o2))
> ; (display "(describe o2) :-\n")
> ; (describe o2)
>
> (dump-gf a-s1 o1)
> (dump-gf a-s1 o2)
>
> --
> Neil W. Van Dyke
> http://www.neilvandyke.org/
>
> _______________________________________________
> Bug-guile mailing list
> Bug-guile@gnu.org
> http://mail.gnu.org/mailman/listinfo/bug-guile
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2003-04-20 11:35 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2002-03-15 8:11 possible goops class redefinition bug Neil W. Van Dyke
2002-04-24 20:50 ` Marius Vollmer
-- strict thread matches above, loose matches on Subject: below --
2003-04-20 11:35 Mikael Djurfeldt
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).