Hi Kevin,
Kevin Ryde <[EMAIL PROTECTED]> writes:
> "Marco Maggi" <[EMAIL PROTECTED]> writes:
>>
>> guile> (equal? (values 1 2) (values 1 2))
>> ERROR: Stack overflow
>
> Thanks, looks like a bug introduced by recursing into structs in
> equal?. I guess scm_i_struct_equalp should check and ignore a field
> type "s" ...
Indeed, good guess!
I propose the following simple fix. Ok to apply?
Actually, `scm_i_struct_equalp ()' should also compare the "tail
elements" (when there are tail elements), but their semantics are a
little fuzzy to me. In particular, I don't understand why the size of
the tail array can be specified in both `make-vtable-vtable' and
`make-struct': What does that mean? Which one should really be taken
into account? It seems that the code is a bit unclear on this too:
guile> (define v (make-vtable-vtable "pr" 0))
guile> (define s (make-struct v 123))
guile> (struct-ref s 10)
Segmentation fault
(Looks like the API is so complex that few people actually bothered to
use it to its full extents. ;-))
Thanks,
Ludovic.
--- orig/libguile/struct.c
+++ mod/libguile/struct.c
@@ -564,8 +564,11 @@
field1 = scm_struct_ref (s1, s_field_num);
field2 = scm_struct_ref (s2, s_field_num);
- if (scm_is_false (scm_equal_p (field1, field2)))
- return SCM_BOOL_F;
+ /* Self-referencing fields (type `s') must be skipped to avoid infinite
+ recursion. */
+ if (!(scm_is_eq (field1, s1) && (scm_is_eq (field2, s2))))
+ if (scm_is_false (scm_equal_p (field1, field2)))
+ return SCM_BOOL_F;
}
return SCM_BOOL_T;
--- orig/test-suite/tests/structs.test
+++ mod/test-suite/tests/structs.test
@@ -82,12 +82,18 @@
(set-owner! ball "Bill")
(string=? (owner ball) "Bill")))
- (pass-if "equal?"
+ (pass-if "equal? (simple structs)"
+ (let* ((vtable (make-vtable-vtable "pr" 0))
+ (s1 (make-struct vtable 0 "hello"))
+ (s2 (make-struct vtable 0 "hello")))
+ (equal? s1 s2)))
+
+ (pass-if "equal? (more complex structs)"
(let ((first (make-ball red (string-copy "Bob")))
- (second (make-ball red (string-copy "Bob"))))
+ (second (make-ball red (string-copy "Bob"))))
(equal? first second)))
(pass-if "not-equal?"
- (not (or (equal? (make-ball red "Bob") (make-ball green "Bill"))
+ (not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
(equal? (make-ball red "Bob") (make-ball red "Bill"))))))
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-guile
