summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2023-06-28 06:55:12 -0700
committerKaz Kylheku <kaz@kylheku.com>2023-06-28 06:55:12 -0700
commit482d35d1d79acf1e7c4f64bc016b400fe930baa6 (patch)
tree0f710f8be8ab9cb1d057c4d86825aed161285b22
parentb21d36d9c86e0c64c8f230713cd0f0263bc98138 (diff)
downloadtxr-482d35d1d79acf1e7c4f64bc016b400fe930baa6.tar.gz
txr-482d35d1d79acf1e7c4f64bc016b400fe930baa6.tar.bz2
txr-482d35d1d79acf1e7c4f64bc016b400fe930baa6.zip
equal: bug: broken equality substitution.
* lib.c (equal): Several cases which react to the type of the left argument have a default path which wrongly short-circuits to an early return. All these cases must break through to the logic at the end of the function which tests the right side for a possible equality substitution. * tests/012/struct.tl: One breaking test cases added. equal was found to return nil for two structures that have equal lists as their equality substitute.
-rw-r--r--lib.c6
-rw-r--r--tests/012/struct.tl8
2 files changed, 11 insertions, 3 deletions
diff --git a/lib.c b/lib.c
index b5eb4d1e..03e6efb8 100644
--- a/lib.c
+++ b/lib.c
@@ -4231,7 +4231,7 @@ val equal(val left, val right)
default:
break;
}
- return nil;
+ break;
case LCONS:
switch (type(right)) {
case CONS:
@@ -4331,7 +4331,7 @@ val equal(val left, val right)
default:
return nil;
}
- return nil;
+ break;
case BGNUM:
if (type(right) == BGNUM) {
if (mp_cmp(mp(left), mp(right)) == MP_EQ)
@@ -4381,7 +4381,7 @@ val equal(val left, val right)
if (type(right) == COBJ && left->co.ops == right->co.ops)
return left->co.ops->equal(left, right);
- return nil;
+ break;
case CPTR:
if (type(right) == CPTR && left->co.ops == right->co.ops)
return left->co.ops->equal(left, right);
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index 93979786..33431780 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -137,3 +137,11 @@
(test (equal #S(foo) #S(foo)) t)
(test (equal #S(foo a 0) #S(foo a 1)) nil)
(test (equal #S(bar a 3 b 3) #S(bar a 3 b 3)) t)
+
+(defstruct eqsub ()
+ key
+ (:method equal (me) me.key))
+
+(test (equal (new eqsub key '(1 2))
+ (new eqsub key '(1 2)))
+ t)