Re: stack overflow equal? values

[Ludovic Courtès]

Hi Kevin,

Kevin Ryde <address@hidden> writes:

> "Marco Maggi" <address@hidden> 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"))))))