diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-12 18:41:44 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 2003-03-12 18:41:44 +0000 |
commit | c9fa174805fbf7a64109bac4ee26b4113f527407 (patch) | |
tree | 7316dde0181ceac357e96c1c59960d17bfba8eaf /oop | |
parent | 3802f9ccd36b0780612fd6011da3b6cdc197213c (diff) | |
download | guile-c9fa174805fbf7a64109bac4ee26b4113f527407.tar.gz |
* goops.scm (merge-generics): Make sure not to merge a gf with
itself. That would be the cause of a real binding collision.
Diffstat (limited to 'oop')
-rw-r--r-- | oop/ChangeLog | 5 | ||||
-rw-r--r-- | oop/goops.scm | 19 |
2 files changed, 16 insertions, 8 deletions
diff --git a/oop/ChangeLog b/oop/ChangeLog index d9a74f87a..b289ae3e0 100644 --- a/oop/ChangeLog +++ b/oop/ChangeLog @@ -1,3 +1,8 @@ +2003-03-12 Mikael Djurfeldt <djurfeldt@nada.kth.se> + + * goops.scm (merge-generics): Make sure not to merge a gf with + itself. That would be the cause of a real binding collision. + 2003-03-11 Mikael Djurfeldt <djurfeldt@nada.kth.se> * goops/util.scm (filter): Removed. (Now supplied by core.) diff --git a/oop/goops.scm b/oop/goops.scm index f33c5a0a8..ff6453404 100644 --- a/oop/goops.scm +++ b/oop/goops.scm @@ -857,7 +857,8 @@ (val2 <generic>) (var <top>) (val <boolean>)) - (make-variable (make-extended-generic (list val2 val1) name))) + (and (not (eq? val1 val2)) + (make-variable (make-extended-generic (list val2 val1) name)))) (define-method (merge-generics (module <module>) (name <symbol>) @@ -867,13 +868,15 @@ (val2 <generic>) (var <top>) (gf <extended-generic>)) - (slot-set! gf - 'extends - (cons val2 (delq! val2 (slot-ref gf 'extends)))) - (slot-set! val2 - 'extended-by - (cons gf (delq! gf (slot-ref val2 'extended-by)))) - var) + (and (not (memq val2 (slot-ref gf 'extends))) + (begin + (slot-set! gf + 'extends + (cons val2 (delq! val2 (slot-ref gf 'extends)))) + (slot-set! val2 + 'extended-by + (cons gf (delq! gf (slot-ref val2 'extended-by)))) + var))) (module-define! duplicate-handlers 'merge-generics merge-generics) |